Find All

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