Function findRange(findItem As Variant, searchRange As Range, Optional lookIn As Variant, Optional lookAt As Variant, Optional matchCase As Boolean) As Range
    Dim C As Range, firstAddress As String
    If IsMissing(lookIn) Then lookIn = xlValues 'xlFormulas
    If IsMissing(lookAt) Then lookAt = xlWhole ' xlPart
    If IsMissing(matchCase) Then matchCase = False
    With searchRange
        Set C = .Find( _
        What:=findItem, _
        lookIn:=lookIn, _
        lookAt:=lookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        matchCase:=matchCase, _
        SearchFormat:=False)
        If Not C Is Nothing Then
            Set findRange = C
            firstAddress = C.Address
            Do
                Set findRange = Union(findRange, C)
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
        End If
    End With
End Function

Function findRangeRecursive(findItems As Variant, searchRanges As Variant, RC As Byte, Optional lookIn As Variant, Optional lookAt As Variant, Optional matchCase As Boolean) As Range
    Dim fii As Long, baseRange As Range, resultRange As Range
    Dim rOffset As Long, cOffset As Long
    If IsMissing(lookIn) Then lookIn = xlValues 'xlFormulas
    If IsMissing(lookAt) Then lookAt = xlWhole ' xlPart
    If IsMissing(matchCase) Then matchCase = False
    Set baseRange = searchRanges(LBound(searchRanges))
    For fii = LBound(findItems) To UBound(findItems)
        If fii < UBound(searchRanges) Then
            If RC = 1 Then rOffset = searchRanges(fii + 1).Row - baseRange.Row
            If RC = 2 Then cOffset = searchRanges(fii + 1).Column - baseRange.Column
        End If
        Set resultRange = findRange(findItem:=findItems(fii), searchRange:=baseRange, lookIn:=lookIn, lookAt:=lookAt, matchCase:=matchCase)
        If resultRange Is Nothing Then
            Set baseRange = Nothing
            Exit For
        Else
            Set baseRange = IIf(fii < UBound(searchRanges), resultRange.Offset(rOffset, cOffset), Nothing)
        End If
    Next fii
    Set findRangeRecursive = resultRange
End Function