Public Function Union(ByRef rng1 As Range, _ 
    ByRef rng2 As Range) As Range 
    If rng1 Is Nothing Then 
        Set Union = rng2 
        Exit Function 
    End If 
    If rng2 Is Nothing Then 
        Set Union = rng1 
        Exit Function 
    End If 
    If Not rng1.Worksheet Is rng2.Worksheet Then 
        Exit Function 
    End If 
    Set Union = Application.Union(rng1, rng2) 
End Function 
 
Public Function MatchAll(ByRef vrnLookupValue As Variant, _ 
    ByRef rngLookupArray As Range) As Range 
    Dim rngArea As Range 
    Dim rngTemp1 As Range 
    Dim rngTemp2 As Range 
    Dim vrnMatch As Variant 
    Dim lngCount As Long 
    Dim lngLast As Long 
     
    If rngLookupArray Is Nothing Then 
        Exit Function 
    End If 
    For Each rngArea In rngLookupArray.Areas 
        If rngArea.Columns.Count > rngArea.Rows.Count Then 
            Set rngTemp1 = rngArea.Rows 
        Else 
            Set rngTemp1 = rngArea.Columns 
        End If 
        For Each rngTemp2 In rngTemp1 
            With rngTemp2 
                lngCount = .Cells.Count 
                lngLast = 0 
                Do 
                    vrnMatch = Application.Match(vrnLookupValue, .Parent.Range(.Cells(lngLast + 1), .Cells(lngCount)), 0) 
                    If IsError(vrnMatch) Then 
                        Exit Do 
                    End If 
                    lngLast = lngLast + vrnMatch 
                    Set MatchAll = Union(MatchAll, .Cells(lngLast)) 
                Loop Until lngLast = lngCount 
            End With 
        Next rngTemp2 
    Next rngArea 
End Function 
 
Public Function MatchRows(ParamArray vrnArgs() As Variant) As Range 
    Dim lngCriteriasCount As Long 
    Dim i As Long 
    Dim rngLookupArray As Range 
    Dim rngMatches As Range 
    Dim rngResult As Range 
     
    lngCriteriasCount = Int((UBound(vrnArgs) - 1) / 2) 
    For i = 0 To lngCriteriasCount 
        If IsObject(vrnArgs(i * 2 + 1)) Then 
            If vrnArgs(i * 2 + 1) Is Nothing Then 
                Exit Function 
            End If 
            If TypeOf vrnArgs(i * 2 + 1) Is Excel.Range Then 
                Set rngLookupArray = vrnArgs(i * 2 + 1) 
                If rngResult Is Nothing Then 
                    Set rngResult = rngLookupArray.EntireRow 
                Else 
                    Set rngLookupArray = Intersect(rngResult, rngLookupArray) 
                End If 
                Set rngMatches = MatchAll(vrnArgs(i * 2), rngLookupArray) 
                If rngMatches Is Nothing Then 
                    Exit Function 
                End If 
                Set rngResult = Application.Intersect(rngResult, rngMatches.EntireRow) 
            End If 
        End If 
    Next i 
    Set MatchRows = rngResult 
End Function