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
<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