search macro retrieving all occurances as well as partial matches

[wCJanssen]

Hi there<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I'm working on a database for a Dutch nursing home, which - if I ever get it to work properly - will eventually contain data on several hundred people. To help users navigate through the records, I created an index-sheet listing all sheets in the workbook, with every sheet representing a single resident. However, I'd like to add a searchbox to this sheet, to simplify matters even further. I found a macro that will search the sheet for a user-defined keyword, but it stops searching after finding the first match. A second macro I got to work does return all instances of a given phrase, but the keyword is case sensitive and it doesn’t retrieve ‘partial matches’. That is: when the user is looking for the records of, say, resident “B Gates” and types “Gates”, nothing comes up – you need to know the residents initials to retrieve his or her records. What I’d like of course is a macro that combines the best of both these codes (returns partial matches and returns all occurrences of the keyword) and I’d be very happy if any one of you could help me out here. The macro’s I have tried so far are as follows: <o></o>
<o></o>
<o></o>
Sub searchmacro1()<o></o>
Dim vFound As Range<o></o>
On Error GoTo ErrorHandle<o></o>
Set vFound = Cells.Find(What:=InputBox("Please enter resident name"), After:=Cells(1, 10), _<o></o>
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _<o></o>
MatchCase:=False, SearchFormat:=False)<o></o>
If Not vFound Is Nothing Then<o></o>
Rows(vFound.Row).Copy Destination:= _<o></o>
ActiveWorkbook.Sheets("002Inhoudsopgave").Range("A1")<o></o>
Exit Sub<o></o>
Else<o></o>
MsgBox ("Your search did not yield any results")<o></o>
Exit Sub<o></o>
End If<o></o>
ErrorHandle:<o></o>
If Err.Number = 9 Then<o></o>
MsgBox ("Error")<o></o>
Else<o></o>
MsgBox (Err.Description)<o></o>
End If <o></o>
End Sub
----------------------------------------------------------------------------------------------------------------------------
Sub Searchmacro2 ()<o></o>
Dim LSearchRow As Integer<o></o>
Dim LCopyToRow As Integer<o></o>
Dim LSearchValue As String<o></o>
On Error GoTo Err_Execute<o></o>
LSearchValue = InputBox("please enter resident name", "Enter name")<o></o>
Rows("2:9").Select<o></o>
Selection.ClearContents<o></o>
LSearchRow = 12<o></o>
LCopyToRow = 2<o></o>
While Len(Range("A" & CStr(LSearchRow)).Value) > 0<o></o>
If Range("A" & CStr(LSearchRow)).Value = LSearchValue Then<o></o>
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select<o></o>
Selection.Copy<o></o>
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select<o></o>
ActiveSheet.Paste<o></o>
LCopyToRow = LCopyToRow + 1<o></o>
Sheets("002Inhoudsopgave").Select<o></o>
End If<o></o>
LSearchRow = LSearchRow + 1<o></o>
Wend<o></o>
Application.CutCopyMode = True<o></o>
Range("A2").Select<o></o>
MsgBox "All matching data has been copied."<o></o>
Exit Sub<o></o>
Err_Execute:<o></o>
MsgBox "An error occurred."<o></o>
End Sub
----------------------------------------------------------------------------------------------------------------------------
Thanks in advance

 

[SteveO59L]

Once you have located instances, what would you like to do ?

List their location in a seperate sheet?

display the location in a message box?

or something else ?

 

[RoryA]

See if this does what you need:

Sub searchmacro1()
   Dim vFound As Range, rngOutput As Range
   Dim strFirstAddress As String
   On Error GoTo ErrorHandle
   Set vFound = Cells.Find(What:=InputBox("Please enter resident name"), After:=Cells(1, 10), _
   LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
   MatchCase:=False, SearchFormat:=False)
   If Not vFound Is Nothing Then
      strFirstAddress = vFound.Address
      Set rngOutput = ActiveWorkbook.Sheets("002Inhoudsopgave").Range("A1")
      Do
         vFound.EntireRow.Copy Destination:=rngOutput
         Set rngOutput = rngOutput.Offset(1, 0)
         Set vFound = Cells.FindNext(vFound)
      Loop Until vFound.Address = strFirstAddress
   Else
      MsgBox ("Your search did not yield any results")
   End If
   Exit Sub
ErrorHandle:
   If Err.Number = 9 Then
      MsgBox ("Error")
   Else
      MsgBox (Err.Description)
   End If
End Sub

 

[wCJanssen]

Once you have located instances, what would you like to do ?

List their location in a seperate sheet?

display the location in a message box?

or something else ?

Sorry, I forgot to mention that - once all instances have been located, I'd like to copy the matching rows either to a different sheet or to the top rows of the active sheet. thanks for your reply.

 

[wCJanssen]

See if this does what you need:

Sub searchmacro1()
   Dim vFound As Range, rngOutput As Range
   Dim strFirstAddress As String
   On Error GoTo ErrorHandle
   Set vFound = Cells.Find(What:=InputBox("Please enter resident name"), After:=Cells(1, 10), _
   LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
   MatchCase:=False, SearchFormat:=False)
   If Not vFound Is Nothing Then
      strFirstAddress = vFound.Address
      Set rngOutput = ActiveWorkbook.Sheets("002Inhoudsopgave").Range("A1")
      Do
         vFound.EntireRow.Copy Destination:=rngOutput
         Set rngOutput = rngOutput.Offset(1, 0)
         Set vFound = Cells.FindNext(vFound)
      Loop Until vFound.Address = strFirstAddress
   Else
      MsgBox ("Your search did not yield any results")
   End If
   Exit Sub
ErrorHandle:
   If Err.Number = 9 Then
      MsgBox ("Error")
   Else
      MsgBox (Err.Description)
   End If
End Sub

Thanks for your (very) fast reply; and it turned out to be quite valuable as well - the macro works perfect! Thanks a lot, I've been struggling with this problem for quite some time.