Excel 2007 search

Sub FindText()

Dim ws As Worksheet, Found As Range, rngNm As String
Dim fText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer

fText = InputBox("Enter the text that you want to search for:", "Start Search!")

If fText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(what:=fText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
foundNum = foundNum + 1
rngNm = .Name
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
thisLoc = rngNm & " " & Found.Address

Sheets(rngNm).Select
Range(Found.Address(RowAbsolute:=False, _
ColumnAbsolute:=False)).Select

myFind = MsgBox("I have located your text """ & fText & """ in cell!" & vbCr & vbCr & _
thisLoc, vbInformation + vbOKCancel + vbDefaultButton1, "Search Result!")

If myFind = 2 Then Exit Sub

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With

Next ws

If Len(AddressStr) Then
MsgBox "Found: """ & fText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, fText & " - was found in these cells only"
Else:
MsgBox "Unable to find your text '" & fText & "' in this workbook.", vbExclamation, "Search Completed!"

End If

End Sub

Select all Open in new window