FindAll
One of the things I hate about the
Range collection's Find method is how cumbersome it is to set up and
use. Not only is it clumsy to detect when one has processed all the
cells that meet the find criteria but it is also not easy to get all
the cells as a single range. The FindAll function simplifies the use
of the Find method. The code supports all the same arguments that
the Find method with the exception that
SearchWhat replaces the
After argument. It can be
- nothing in which case the
code searches the activesheet's usedrange
- a specific worksheet or a
single cell in which case the code searches that worksheet's
usedrange
- a specific range in which
case the code searches just that range
Option Explicit
Private Function FindAll(What, Optional SearchWhat As Variant, _
Optional LookIn, Optional LookAt, _
Optional SearchOrder, Optional SearchDirection As XlSearchDirection = xlNext, _
Optional MatchCase As Boolean = False, _
Optional MatchByte, Optional SearchFormat) As Range
Dim aRng As Range
If IsMissing(SearchWhat) Then
On Error Resume Next
Set aRng = ActiveSheet.UsedRange
On Error GoTo 0
ElseIf TypeOf SearchWhat Is Range Then
If SearchWhat.Cells.Count = 1 Then
Set aRng = SearchWhat.Parent.UsedRange
Else
Set aRng = SearchWhat
End If
ElseIf TypeOf SearchWhat Is Worksheet Then
Set aRng = SearchWhat.UsedRange
Else
Exit Function '*****
End If
If aRng Is Nothing Then Exit Function '*****
Dim FirstCell As Range, CurrCell As Range
With aRng.Areas(aRng.Areas.Count)
Set FirstCell = .Cells(.Cells.Count)
'This little 'dance' ensures we get the first matching _
cell in the range first
End With
Set FirstCell = aRng.Find(What:=What, After:=FirstCell, _
LookIn:=LookIn, LookAt:=LookAt, _
SearchDirection:=SearchDirection, MatchCase:=MatchCase, _
MatchByte:=MatchByte, SearchFormat:=SearchFormat)
If FirstCell Is Nothing Then Exit Function '*****
Set CurrCell = FirstCell
Set FindAll = CurrCell
Do
Set FindAll = Application.Union(FindAll, CurrCell)
'Setting FindAll at the top of the loop ensures _
the result is arranged in the same sequence as _
the matching cells; the duplicate assignment of _
the first matching cell to FindAll being a small _
price to pay for the ordered result
Set CurrCell = aRng.FindNext(CurrCell)
Loop Until CurrCell.Address = FirstCell.Address
End Function
Sub testIt()
MsgBox FindAll(1, , xlValues, xlWhole).Address
MsgBox FindAll(1, , xlValues, xlPart).Address
MsgBox FindAll("(", , xlFormulas, xlPart).Address
MsgBox FindAll(1, Range("a1:a10"), xlValues, xlPart).Address
End Sub