Here is simplest Find All Method
Code:
Sub FindallM()
Dim rngFind As Range
Dim rngWhole As Range
Dim rngUnion As Range
Dim rngFirstFind As Range
Dim rngFirst
Dim strFind As String
On Error Resume Next
strFind = InputBox("Please Enter string to find")
If Err.Number = 13 Then
GoTo x1:
End If
Set rngWhole = ActiveSheet.UsedRange
Set rngFind = rngWhole.Find(strFind, , , xlPart, , , False)
If Not rngFind Is Nothing Then
Set rngUnion = rngFind
Set rngFirst = rngFind
Do
On Error Resume Next
Set rngFind = rngWhole.FindNext(rngFind)
Set rngUnion = Union(rngUnion, rngFind)
Loop Until rngFind.Address = rngFirst.Address
Err.Clear: On Error GoTo 0: On Error GoTo -1
rngUnion.Select
End If
x1:
End Sub
Bookmarks