Excel VBA .Find method - am I clueless?

[Joe in Australia via OfficeKB.com]

I want a function which will return a range containing all the cells matching
certain criteria: like .find, but returning more than one cell at a time. I
tried this and I get really weird results - sometimes it skips cells,
sometimes it loops forever. Any suggestions?

'Takes the same arguments as the built-in .Find, plus an argument specifying
the range to work on.
Function FindRange(MyRange As Range, What As Variant, Optional After As
Variant, Optional LookIn As Variant, Optional LookAt As Variant, Optional
SearchOrder As Variant, Optional SearchDirection As XlSearchDirection,
Optional MatchCase As Variant, Optional Matchbyte As Variant, Optional
Searchformat As Variant) As Range

Dim TempFindRange As Excel.Range

Dim ResultRange As Excel.Range
Dim FirstAddress As String

Set ResultRange = MyRange.Find(What:=What, After:=After, LookIn:=LookIn,
LookAt:=LookAt, SearchOrder:=SearchOrder, SearchDirection:=SearchDirection,
MatchCase:=MatchCase, Matchbyte:=Matchbyte, Searchformat:=Searchformat)

Set TempFindRange = ResultRange

If Not ResultRange Is Nothing Then
FirstAddress = ResultRange.Address
Do
TempFindRange = Excel.Union(TempFindRange, ResultRange)
Set ResultRange = MyRange.FindNext(ResultRange)
Loop While (ResultRange.Address <> FirstAddress)
End If
Set FindRange = TempFindRange
End Function

 

[Ron de Bruin]

Hi Joe

Try this one for the str "ron" in Sheets("Sheet1").Range("A:A")

Sub Union_in_column()
Dim FirstAddress As String
Dim str As String
Dim rng As Range
Dim rng2 As Range

str = "ron"

With Sheets("Sheet1").Range("A:A")

Set rng = .Find(What:=str, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'If you want to find a part of the rng.value then use xlPart
'if you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "ron"

If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
If rng2 Is Nothing Then
Set rng2 = rng
Else
Set rng2 = Application.Union(rng2, rng)
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> FirstAddress
End If
End With

'Select all cells
If Not rng2 Is Nothing Then rng2.Select

End Sub