Function FindAll(SearchRange As Range, _
                FindWhat As Variant, _
               Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlWhole, _
                Optional SearchOrder As XlSearchOrder = xlByRows, _
                Optional MatchCase As Boolean = False, _
                Optional BeginsWith As String = vbNullString, _
                Optional EndsWith As String = vbNullString, _
                Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
Dim foundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long


CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
    XLookAt = xlPart
Else
    XLookAt = LookAt
End If

For Each Area In SearchRange.Areas
    With Area
        If .Cells(.Cells.count).Row > MaxRow Then
            MaxRow = .Cells(.Cells.count).Row
        End If
        If .Cells(.Cells.count).Column > MaxCol Then
            MaxCol = .Cells(.Cells.count).Column
        End If
    End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)


On Error GoTo 0
Set foundCell = SearchRange.Find(What:=FindWhat, _
        After:=LastCell, _
        LookIn:=LookIn, _
        LookAt:=xlPart, _
        SearchOrder:=SearchOrder, _
        MatchCase:=MatchCase)

If Not foundCell Is Nothing Then
    Set FirstFound = foundCell
    Set ResultRange = foundCell
    Set foundCell = SearchRange.FindNext(After:=foundCell)
    Do Until False ' Loop forever. We'll "Exit Do" when necessary.
        If (foundCell Is Nothing) Then
            Exit Do
        End If
        If (foundCell.Address = FirstFound.Address) Then
            Exit Do
        End If
        Include = False

        If BeginsWith = vbNullString Then
            If EndsWith = vbNullString Then
                Include = True
            Else
                If Len(foundCell.text) < Len(EndsWith) Then
                    Include = False
                Else
                    If StrComp(Right(foundCell.text, Len(EndsWith)), EndsWith, CompMode) = 0 Then
                        Include = True
                    Else
                        Include = False
                    End If
                End If
            End If
        End If
        If EndsWith = vbNullString Then
            If BeginsWith = vbNullString Then
                Include = True
            Else
                If StrComp(Left(foundCell.text, Len(BeginsWith)), BeginsWith, CompMode) = 0 Then
                    Include = True
                Else
                    Include = False
                End If
            End If
        Else
            If Len(foundCell.text) < Len(EndsWith) Then
                Include = False
            Else
                If StrComp(Right(foundCell.text, Len(EndsWith)), EndsWith, CompMode) = 0 Then
                    Include = True
                Else
                    Include = False
                End If
            End If
        End If

        If Include = True Then
            Set ResultRange = Application.Union(ResultRange, foundCell)
        End If
        Set foundCell = SearchRange.FindNext(After:=foundCell)
    Loop
End If

Set FindAll = ResultRange

End Function