VBA: Index/Match with multiple criteria

Question

I'm currently trying to figure out how to write a macro that will allow me to run a index/match with two criteria. I have a large database of information containing transaction information from multiple countries. I'd like to reference data in the "country" column and "date" column to match with a separate worksheet that contains foreign exchange rates. For countries and dates that match it would return the exchange rate for that date. I'd like the macro to run down to the last row of data in my sheet (it varies from time to time)

The formula syntax I originally created is:

=INDEX('FX_Index Lookup'!G:G,MATCH('Tool'!CJ2&'Tool'!DT2,'FX_Index Lookup'!C:C&'FX_Index Lookup'!H:H,0),FALSE)

When I drag this formula down, excel runs out of resources to continue running the calculation on the amount of data (rows) I need. I was hoping a Macro could solve this issue

You could make helper columns with the concatenated values then use a non array vlookup or INDEX/MATCH. — Scott Craner

drgs drgs · Accepted Answer · 2017-03-08T14:40:46

The last function MatchQuery will return cells in column ReturnCol, where CriteriaColA = CriteriaA, CriteriaColB = CriteriaB... (similar syntax to SUMIFS)

Set rngRes = MatchQuery(ReturnCol, CriteriaColA, CriteriaA, CriteriaColB, CriteriaB ... etc)

Public Function IsRange(ByRef vnt As Variant) As Boolean
    If IsObject(vnt) Then
        If Not vnt Is Nothing Then
            IsRange = TypeOf vnt Is Excel.Range
        End If
    End If
End Function

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 vntLookupValue As Variant, _
                         ByRef rngLookupArray As Range) As Range
    Dim rngArea As Range
    Dim rngTemp1 As Range
    Dim rngTemp2 As Range
    Dim vntMatch 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
                    vntMatch = Application.Match(vntLookupValue, .Parent.Range(.Cells(lngLast + 1), .Cells(lngCount)), 0)
                    If IsError(vntMatch) Then
                        Exit Do
                    End If
                    lngLast = lngLast + vntMatch
                    Set MatchAll = Union(MatchAll, .Cells(lngLast))
                Loop Until lngLast = lngCount
            End With
        Next rngTemp2
    Next rngArea
End Function

Public Function MatchQuery(ByRef rngLookupArray As Range, _
                           ParamArray avntArgs() As Variant) As Range
    Dim rngResult As Range
    Dim i As Long
    Dim rngTemp As Range
    Dim rngMatches As Range

    Set rngResult = rngLookupArray
    For i = 0 To UBound(avntArgs) - 1 Step 2
        If Not IsRange(avntArgs(i)) Then
            Exit Function
        End If
        Set rngTemp = avntArgs(i)
        Set rngMatches = MatchAll(avntArgs(i + 1), Intersect(rngResult.EntireRow, rngTemp))
        If rngMatches Is Nothing Then
            Exit Function
        End If
        Set rngResult = Application.Intersect(rngResult, rngMatches.EntireRow)
    Next i
    Set MatchQuery = rngResult
End Function

VBA: Index/Match with multiple criteria

1 Answers