• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Find the detail from external file

sanju

Member
I am trying to find the land owner's information in kalus village. But the result is not right.
Land Owner - "Hon.Collector & Dy. Director Rehabilitation (Land) Pune" in this serial number 1,21,43,46,71,76.
Please correct the code or give me new code.

Thanks a lot

Sorry for my bad english
 

Attachments

  • Search Owner.zip
    298.1 KB · Views: 8
Try:
Code:
Sub SearchOwner()
Dim SearchName As String, Searchvillage As String
Dim Frng As Range
Dim T As Long, Startrow As Long, Endrow As Long, TotCount As Long
Dim Namefound As String, Villagefound As String, Filepath As String
Dim ws As Worksheet

Namefound = "NO"
Villagefound = "NO"

Filepath = ActiveWorkbook.Path
Set ws = ActiveSheet

If ws.Range("D3") = "" Then
  ws.Range("D3") = InputBox("Enter Land Owner name")
End If
SearchName = ws.Range("D3")

If ws.Range("D1") = "" Then
  ws.Range("D1") = InputBox("Enter village name")
End If
Searchvillage = ws.Range("D1")

ws.Range("A8:P1000").Delete
ws.Range("A8:P1000").Borders.LineStyle = xlNone

'Opening the village file
'Workbooks.Open Filename:=Filepath & "\Village\" & Searchvillage & ".xls"
Set SourceFile = Workbooks.Open(Filename:=Filepath & "\Village\" & Searchvillage & ".xls")  '<< changed from original line above.
Set SourceSheet = ActiveSheet  '<< added...

With SourceSheet  '...and used here.
  Set Frng = .Range("I1")
  TotCount = WorksheetFunction.CountIf(.Range("I:I"), SearchName)
  Startrow = 2
  Endrow = 1

  Do While Not Frng Is Nothing
    X = X + Endrow - Startrow + 1  '<< changed added X +, see commented-out line below (original).
    'X = Endrow - Startrow + 1

    Set Frng = .Range("I:I").Find(What:=SearchName, After:=.Range("I" & Endrow), LookIn:= _
              xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
              , MatchCase:=False, SearchFormat:=False)  'Exact search to Change LookAt:=xlWhole

    If Not Frng Is Nothing Then
      If X = 0 Then
        Adrs = Frng.Address
      Else
        If Adrs = Frng.Address Then Exit Do
      End If
      'Startrow >= Frng.Row Then Exit Do

      Namefound = "YES"

      If .Range("A" & Frng.Row) = "" Then
        Startrow = .Range("A" & Frng.Row).End(xlUp).Row  '<< changed: added a dot before Range.
      Else
        Startrow = Frng.Row
      End If

      If .Range("A" & Frng.Row).Offset(1, 0) = "" Then  '<< changed: added a dot before Range.
        Endrow = .Range("A" & Frng.Row).End(xlDown).Offset(-1, 0).Row  '<< changed added a dot before Range.
      Else
        Endrow = Frng.Row
      End If

      ws.Range("A" & 8 + X & ":P" & 8 + X + Endrow - Startrow).Value = .Range("A" & Startrow & ":P" & Endrow).Value
      ws.Range("A" & 8 + X & ":P" & 8 + X + Endrow - Startrow).Borders.LineStyle = xlContinuous
    End If
  Loop
End With
SourceFile.Close  'changed from: ActiveWindow.Close
If Namefound = "NO" Then MsgBox ("Land owner """ & SearchName & """ not found.")
End Sub
See comments in code for changes.
 
Try:
Code:
Sub SearchOwner()
Dim SearchName As String, Searchvillage As String
Dim Frng As Range
Dim T As Long, Startrow As Long, Endrow As Long, TotCount As Long
Dim Namefound As String, Villagefound As String, Filepath As String
Dim ws As Worksheet

Namefound = "NO"
Villagefound = "NO"

Filepath = ActiveWorkbook.Path
Set ws = ActiveSheet

If ws.Range("D3") = "" Then
  ws.Range("D3") = InputBox("Enter Land Owner name")
End If
SearchName = ws.Range("D3")

If ws.Range("D1") = "" Then
  ws.Range("D1") = InputBox("Enter village name")
End If
Searchvillage = ws.Range("D1")

ws.Range("A8:P1000").Delete
ws.Range("A8:P1000").Borders.LineStyle = xlNone

'Opening the village file
'Workbooks.Open Filename:=Filepath & "\Village\" & Searchvillage & ".xls"
Set SourceFile = Workbooks.Open(Filename:=Filepath & "\Village\" & Searchvillage & ".xls")  '<< changed from original line above.
Set SourceSheet = ActiveSheet  '<< added...

With SourceSheet  '...and used here.
  Set Frng = .Range("I1")
  TotCount = WorksheetFunction.CountIf(.Range("I:I"), SearchName)
  Startrow = 2
  Endrow = 1

  Do While Not Frng Is Nothing
    X = X + Endrow - Startrow + 1  '<< changed added X +, see commented-out line below (original).
    'X = Endrow - Startrow + 1

    Set Frng = .Range("I:I").Find(What:=SearchName, After:=.Range("I" & Endrow), LookIn:= _
              xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
              , MatchCase:=False, SearchFormat:=False)  'Exact search to Change LookAt:=xlWhole

    If Not Frng Is Nothing Then
      If X = 0 Then
        Adrs = Frng.Address
      Else
        If Adrs = Frng.Address Then Exit Do
      End If
      'Startrow >= Frng.Row Then Exit Do

      Namefound = "YES"

      If .Range("A" & Frng.Row) = "" Then
        Startrow = .Range("A" & Frng.Row).End(xlUp).Row  '<< changed: added a dot before Range.
      Else
        Startrow = Frng.Row
      End If

      If .Range("A" & Frng.Row).Offset(1, 0) = "" Then  '<< changed: added a dot before Range.
        Endrow = .Range("A" & Frng.Row).End(xlDown).Offset(-1, 0).Row  '<< changed added a dot before Range.
      Else
        Endrow = Frng.Row
      End If

      ws.Range("A" & 8 + X & ":P" & 8 + X + Endrow - Startrow).Value = .Range("A" & Startrow & ":P" & Endrow).Value
      ws.Range("A" & 8 + X & ":P" & 8 + X + Endrow - Startrow).Borders.LineStyle = xlContinuous
    End If
  Loop
End With
SourceFile.Close  'changed from: ActiveWindow.Close
If Namefound = "NO" Then MsgBox ("Land owner """ & SearchName & """ not found.")
End Sub
See comments in code for changes.
Try:
Code:
Sub SearchOwner()
Dim SearchName As String, Searchvillage As String
Dim Frng As Range
Dim T As Long, Startrow As Long, Endrow As Long, TotCount As Long
Dim Namefound As String, Villagefound As String, Filepath As String
Dim ws As Worksheet

Namefound = "NO"
Villagefound = "NO"

Filepath = ActiveWorkbook.Path
Set ws = ActiveSheet

If ws.Range("D3") = "" Then
  ws.Range("D3") = InputBox("Enter Land Owner name")
End If
SearchName = ws.Range("D3")

If ws.Range("D1") = "" Then
  ws.Range("D1") = InputBox("Enter village name")
End If
Searchvillage = ws.Range("D1")

ws.Range("A8:P1000").Delete
ws.Range("A8:P1000").Borders.LineStyle = xlNone

'Opening the village file
'Workbooks.Open Filename:=Filepath & "\Village\" & Searchvillage & ".xls"
Set SourceFile = Workbooks.Open(Filename:=Filepath & "\Village\" & Searchvillage & ".xls")  '<< changed from original line above.
Set SourceSheet = ActiveSheet  '<< added...

With SourceSheet  '...and used here.
  Set Frng = .Range("I1")
  TotCount = WorksheetFunction.CountIf(.Range("I:I"), SearchName)
  Startrow = 2
  Endrow = 1

  Do While Not Frng Is Nothing
    X = X + Endrow - Startrow + 1  '<< changed added X +, see commented-out line below (original).
    'X = Endrow - Startrow + 1

    Set Frng = .Range("I:I").Find(What:=SearchName, After:=.Range("I" & Endrow), LookIn:= _
              xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
              , MatchCase:=False, SearchFormat:=False)  'Exact search to Change LookAt:=xlWhole

    If Not Frng Is Nothing Then
      If X = 0 Then
        Adrs = Frng.Address
      Else
        If Adrs = Frng.Address Then Exit Do
      End If
      'Startrow >= Frng.Row Then Exit Do

      Namefound = "YES"

      If .Range("A" & Frng.Row) = "" Then
        Startrow = .Range("A" & Frng.Row).End(xlUp).Row  '<< changed: added a dot before Range.
      Else
        Startrow = Frng.Row
      End If

      If .Range("A" & Frng.Row).Offset(1, 0) = "" Then  '<< changed: added a dot before Range.
        Endrow = .Range("A" & Frng.Row).End(xlDown).Offset(-1, 0).Row  '<< changed added a dot before Range.
      Else
        Endrow = Frng.Row
      End If

      ws.Range("A" & 8 + X & ":P" & 8 + X + Endrow - Startrow).Value = .Range("A" & Startrow & ":P" & Endrow).Value
      ws.Range("A" & 8 + X & ":P" & 8 + X + Endrow - Startrow).Borders.LineStyle = xlContinuous
    End If
  Loop
End With
SourceFile.Close  'changed from: ActiveWindow.Close
If Namefound = "NO" Then MsgBox ("Land owner """ & SearchName & """ not found.")
End Sub
See comments in code for changes.

Thank you so much, work perfect.
 
Back
Top