Hi there,
My last visit to mrexcel.com got me a great macro that searches a sheet for a user-defined value and pastes any full and partial matches to a different sheet in the same workbook. I would like to adapt this macro a little now though, so that it shows any results in a listbox, in stead of on a sheet. I would greatly appreciate it if anyone could adapt the current code for me:
Private Sub Retrieve_Click()
Dim vFound As Range, rngOutput As Range
Dim strFirstAddress As String
On Error GoTo ErrorHandle
Set vFound = Cells.Find(What:=query.Value, After:=Cells(1, 10), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
With Sheets("Database").Range("Names")
If Not vFound Is Nothing Then
strFirstAddress = vFound.Address
Set rngOutput = ActiveWorkbook.Sheets("Searchresults").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 does not yield any results")
End If
Exit Sub
ErrorHandle:
If Err.Number = 9 Then
MsgBox ("Error")
Else
MsgBox (Err.Description)
End If '
End With
End Sub
Thanks in advance
My last visit to mrexcel.com got me a great macro that searches a sheet for a user-defined value and pastes any full and partial matches to a different sheet in the same workbook. I would like to adapt this macro a little now though, so that it shows any results in a listbox, in stead of on a sheet. I would greatly appreciate it if anyone could adapt the current code for me:
Private Sub Retrieve_Click()
Dim vFound As Range, rngOutput As Range
Dim strFirstAddress As String
On Error GoTo ErrorHandle
Set vFound = Cells.Find(What:=query.Value, After:=Cells(1, 10), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
With Sheets("Database").Range("Names")
If Not vFound Is Nothing Then
strFirstAddress = vFound.Address
Set rngOutput = ActiveWorkbook.Sheets("Searchresults").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 does not yield any results")
End If
Exit Sub
ErrorHandle:
If Err.Number = 9 Then
MsgBox ("Error")
Else
MsgBox (Err.Description)
End If '
End With
End Sub
Thanks in advance