search macro retrieving all occurances as well as partial matches

wCJanssen

New Member
Joined
Feb 22, 2009
Messages
24
Hi there<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
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:p></o:p>
<o:p></o:p>
<o:p></o:p>
Sub searchmacro1()<o:p></o:p>
Dim vFound As Range<o:p></o:p>
On Error GoTo ErrorHandle<o:p></o:p>
Set vFound = Cells.Find(What:=InputBox("Please enter resident name"), After:=Cells(1, 10), _<o:p></o:p>
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _<o:p></o:p>
MatchCase:=False, SearchFormat:=False)<o:p></o:p>
If Not vFound Is Nothing Then<o:p></o:p>
Rows(vFound.Row).Copy Destination:= _<o:p></o:p>
ActiveWorkbook.Sheets("002Inhoudsopgave").Range("A1")<o:p></o:p>
Exit Sub<o:p></o:p>
Else<o:p></o:p>
MsgBox ("Your search did not yield any results")<o:p></o:p>
Exit Sub<o:p></o:p>
End If<o:p></o:p>
ErrorHandle:<o:p></o:p>
If Err.Number = 9 Then<o:p></o:p>
MsgBox ("Error")<o:p></o:p>
Else<o:p></o:p>
MsgBox (Err.Description)<o:p></o:p>
End If <o:p></o:p>
End Sub
----------------------------------------------------------------------------------------------------------------------------
Sub Searchmacro2 ()<o:p></o:p>
Dim LSearchRow As Integer<o:p></o:p>
Dim LCopyToRow As Integer<o:p></o:p>
Dim LSearchValue As String<o:p></o:p>
On Error GoTo Err_Execute<o:p></o:p>
LSearchValue = InputBox("please enter resident name", "Enter name")<o:p></o:p>
Rows("2:9").Select<o:p></o:p>
Selection.ClearContents<o:p></o:p>
LSearchRow = 12<o:p></o:p>
LCopyToRow = 2<o:p></o:p>
While Len(Range("A" & CStr(LSearchRow)).Value) > 0<o:p></o:p>
If Range("A" & CStr(LSearchRow)).Value = LSearchValue Then<o:p></o:p>
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select<o:p></o:p>
Selection.Copy<o:p></o:p>
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select<o:p></o:p>
ActiveSheet.Paste<o:p></o:p>
LCopyToRow = LCopyToRow + 1<o:p></o:p>
Sheets("002Inhoudsopgave").Select<o:p></o:p>
End If<o:p></o:p>
LSearchRow = LSearchRow + 1<o:p></o:p>
Wend<o:p></o:p>
Application.CutCopyMode = True<o:p></o:p>
Range("A2").Select<o:p></o:p>
MsgBox "All matching data has been copied."<o:p></o:p>
Exit Sub<o:p></o:p>
Err_Execute:<o:p></o:p>
MsgBox "An error occurred."<o:p></o:p>
End Sub
----------------------------------------------------------------------------------------------------------------------------
Thanks in advance
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

SteveO59L

Well-known Member
Joined
Apr 21, 2004
Messages
7,896
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

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
35,121
Office Version
365, 2019, 2016, 2010
Platform
Windows, MacOS
See if this does what you need:
Code:
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

New Member
Joined
Feb 22, 2009
Messages
24
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

New Member
Joined
Feb 22, 2009
Messages
24
See if this does what you need:
Code:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,362
Messages
5,486,391
Members
407,544
Latest member
mguevara

This Week's Hot Topics

Top