List Search Results in a UserForm
 

One thing that I've found to be a pain in Excel VBA is performing
search in a document. But with the help from a few of you in thi
forum, I've been able to come up with something that I think work
pretty good (I may be wrong, but what do I know... I've only been usin
Excel and VBA for about a month now). So here's what I'm giving bac
to this group.

This may need a little bit of an intro...
First, just copy and paste this code into a blank UserForm.
Add a CommandButton and rename it to cmdClose.
Add a ListView control and rename it to lvwSearchResults.

Now add some code to call the form and perform a search.
The results will be put into 3 columns: Sheet name, cell address an
cell value.
When you click on any of the entries, it will auto-magically take yo
to the selected sheet/cell.

Enjoy!


Option Explicit


Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub lvwSearchResults_Click()
Dim i As Integer
Dim strSheet As String
Dim strCell As String

i = lvwSearchResults.SelectedItem.Index
strSheet = lvwSearchResults.ListItems.Item(i)
strCell = lvwSearchResults.ListItems(i).ListSubItems(1).Text

Sheets(strSheet).Select
Range(strCell).Select
End Sub

Private Sub UserForm_Initialize()
Dim oSheet As Object
Dim Firstcell As Range
Dim NextCell As Range
Dim WhatToFind As Variant
Dim strCellText As String

lvwSearchResults.ListItems.Clear
lvwSearchResults.ColumnHeaders.Add (1), , "Sheet Name"
lvwSearchResults.ColumnHeaders.Add (2), , "Cell Address"
lvwSearchResults.ColumnHeaders.Add (3), , "Cell Value"

WhatToFind = Application.InputBox("What are you looking for ?"
"Search", , 100, 100, , , 2)
If WhatToFind < "" And Not WhatToFind = False Then
For Each oSheet In ActiveWorkbook.Worksheets
oSheet.Activate
oSheet.[a1].Activate
Set Firstcell = Cells.Find(What:=WhatToFind
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows
SearchDirection:=xlNext, MatchCase:=False)
If Not Firstcell Is Nothing Then
Firstcell.Activate
lvwSearchResults.ListItems.Add (1), , oSheet.Name
lvwSearchResults.ListItems(1).SubItems(1)
Firstcell.Address ' WhatToFind
strCellText = Firstcell.Value
lvwSearchResults.ListItems(1).SubItems(2)
strCellText
On Error Resume Next
While (Not NextCell Is Nothing) And (No
NextCell.Address = Firstcell.Address)
Set NextCell = Cells.FindNext(After:=ActiveCell)
If Not NextCell.Address = Firstcell.Address Then
NextCell.Activate
lvwSearchResults.ListItems.Add (1),
oSheet.Name
lvwSearchResults.ListItems(1).SubItems(1)
NextCell.Address ' WhatToFind
strCellText = NextCell.Value
lvwSearchResults.ListItems(1).SubItems(2)
strCellText
End If
Wend
End If
Set NextCell = Nothing
Set Firstcell = Nothing
Next oSheet
End If
End Sub

~ Matt

--
Message posted from http://www.ExcelForum.com