VBA - Find every occurance of string in workbook, write to 1st she

[Guest]

Hi,

I'm trying to seach all worksheets in a workbook [except the first
worksheet] for a string that is supplied from a inputbox on the first
worksheet.

The results of the search should be written to rows on the first worksheet
with links to the matched occurance [like the FindAll in the Find Dialog box].

I have been working toward the solution - here is my code so far...
------------------------
Private Sub cmdSearch_Click()

Dim rng As Range, sh As Worksheet
Dim r, c As Integer
Dim Found As Boolean
Dim firstAddress As Variant
Dim strWhatToFind As String

c = 4
r = 15
Reenter:
strWhatToFind = Application.InputBox("Enter a word or phrase...", "Search")
If strWhatToFind = "" Then
Response = MsgBox("Please enter search criteria.", vbOKOnly, "Oops!")
GoTo Reenter
End If
If strWhatToFind <> "False" Then
For Each sh In ThisWorkbook.Worksheets
sh.Activate
Set rng = Cells.Find(What:=WhatToFind, _
After:=Range("IV65536"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
Worksheets("Title").Cells(r, c).Value = sh.Range(rng.Address).Value
r = r + 1
Loop While Not rng Is Nothing And rng.Address <> firstAddress
Found = True
End If
Next
Worksheets(1).Activate
If Not Found Then
MsgBox ("Customer Data not found")
Else
MsgBox ("Done")
End If
End If
End Sub

 

[Tom Ogilvy]

Private Sub cmdSearch_Click()

Dim rng As Range, sh As Worksheet
Dim r, c As Integer
Dim Found As Boolean
Dim firstAddress As String
Dim strWhatToFind As String

c = 4
r = 15
Found = False
Reenter:
strWhatToFind = Application.InputBox("Enter a word or phrase...",
"Search")
If strWhatToFind = "" Then
Response = MsgBox("Please enter search criteria.", vbOKOnly, "Oops!")
GoTo Reenter
End If
If strWhatToFind <> "False" Then
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> ThisWorkbook.Worksheets(1).Name Then

Set rng = sh.Cells.Find(What:=WhatToFind, _
After:=Range("IV65536"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False), _
SearchFormat:=False)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
Worksheets(1).Cells(r, c).Value = _
rng.Value
r = r + 1
Set rng = sh.Cells.FindNext(rng)
Loop While Not rng Is Nothing And _
rng.Address <> firstAddress
Found = True
End If
End If
Next
End If
Worksheets(1).Activate
If Not Found Then
MsgBox ("Customer Data not found")
Else
MsgBox ("Done")
End If

End Sub