VLookup with Multiple Criteria with VBA and the array formula method-CodePudding

So the idea is to make use of the beautiful Array Formula Method and the idea behind it, when it is needed to make a VLookUp with multiple criteria in VBA.

The question: can we translate this into VBA:

{=INDEX(range1,MATCH(1,(A1=range2)*(B1=range3)*(C1=range4),0))}

Without using formulas in Excel at all? E.g., without doing this:

=AGGREGATE(15, 6, '[TUR Master Report.xlsm]Archive'!$B$2:$B$13/
                  (('[TUR Master Report.xlsm]Archive'!$B$2:$B$13>=DO2)*
                   ('[TUR Master Report.xlsm]Archive'!$B$2:$B$13<=DP2)*
                   ('[TUR Master Report.xlsm]Archive'!$A$2:$A$13=A2)), 1)

or anything similar (.ArrayFormula,.Formula, etc).

I was thinking about something like this foo = Match(1,(A1=rangeA)*(B1=rangeB)*(C1=rangeC),0), but of course it does not work, although it is in the logic of the Excel formula. So far I have created the following as a workaround:

Function GetLookupDataTriple(tableName As String, lookIntoColumn As String, myArray As Variant) As Variant
    
    Dim lo As ListObject
    Set lo = Sheet1.ListObjects(tableName)
    
    Dim i As Long
    For i = 2 To lo.ListColumns(myArray(0)).Range.Rows.Count
        If lo.ListColumns(myArray(0)).Range.Cells(RowIndex:=i) = myArray(1) Then
            If lo.ListColumns(myArray(2)).Range.Cells(RowIndex:=i) = myArray(3) Then
                If lo.ListColumns(myArray(4)).Range.Cells(RowIndex:=i) = myArray(5) Then
                    GetLookupDataTriple = lo.ListColumns(lookIntoColumn).Range.Cells(RowIndex:=i)
                    Exit Function
                End If
            End If
        End If
    Next i
    
    GetLookupDataTriple = -1
    
End Function

which works quite ok with 3 filters, but the idea is to be a bit fancier, e.g. like in the excel original formula.

CodePudding user response：

Moving to Select Case from Ifs would at least make things cleaner to add more criteria later (cleanliness is fanciness?); just add new cases, rather than messing with If and spacing, etc. My mock-up:

For i = 2 To lo.ListColumns(myArray(0)).Range.Rows.Count
    Select Case False
        Case lo.ListColumns(myArray(0)).Range.Cells(RowIndex:=i) = myArray(1)
        Case lo.ListColumns(myArray(2)).Range.Cells(RowIndex:=i) = myArray(3)
        Case lo.ListColumns(myArray(4)).Range.Cells(RowIndex:=i) = myArray(5)
        Case Else 
            GetLookupDataTriple = lo.ListColumns(lookIntoColumn).Range.Cells(RowIndex:=i)
            Exit For
    End Select
Next i

This definitely isn't down to your foo = Match(1,(A1=rangeA)*(B1=rangeB)*(C1=rangeC),0) level of fancy/clean, though.

CodePudding user response：

Do you want a way to lookup n number of criteria?

assuming the following data:

You could use XLOOKUP:

=XLOOKUP(1&1&1,A1:A9&B1:B9&C1:C9,D1:D9,"Not Found";)

This will find the last row where a,b, and c = 1 and result is 8

CodePudding user response：

How abut the following:

Sub Macro1()
'
' Macro1 Macro
'

'
Dim myArray(5) As Variant
myArray(0) = "a"
myArray(1) = 1
myArray(2) = "b"
myArray(3) = 1
myArray(4) = "c"
myArray(5) = 1

    MsgBox (GetLookupDataTriple2("Table1", "result", myArray))
End Sub


Function GetLookupDataTriple2(tableName As String, lookIntoColumn As String, myArray As Variant) As Variant
    
    Dim lo As ListObject
    Set lo = Sheet1.ListObjects(tableName)
    
    noOfSearchParam = UBound(myArray) - LBound(myArray)
    
    Dim found As Boolean
    
    For i = 2 To lo.ListColumns(myArray(0)).Range.Rows.Count
     found = True
        For s = 0 To noOfSearchParam Step 2
            If lo.ListColumns(myArray(s)).Range.Cells(RowIndex:=i) <> myArray(s   1) Then
                 found = False
            End If
        Next s
        If found Then
            GetLookupDataTriple2 = lo.ListColumns(lookIntoColumn).Range.Cells(RowIndex:=i)
            Exit Function
        End If
    Next i
    GetLookupDataTriple2 = -1
End Function

CodePudding user response：

Here is a paramarray version of match that accepts any number of vertical arrays of the same size or ranges of the same size and returns the relative row number:

Function myArrayMatch(ParamArray arr() As Variant) As Long
    If UBound(arr) Mod 2 <> 1 Then
        myArrayMatch = -1
        Exit Function
    End If
    Dim lgth As Long
    If TypeName(arr(LBound(arr))) = "Range" Then
        lgth = Intersect(arr(LBound(arr)).Parent.UsedRange, arr(LBound(arr))).Cells.Count
    Else
        lgth = UBound(arr(LBound(arr)))   LBound(arr(LBound(arr))) - 1
    End If
    Dim fnd() As Boolean
    ReDim fnd(1 To lgth) As Boolean

    Dim i As Long
    For i = LBound(arr) To UBound(arr) Step 2
        Dim rngarr As Variant
        If TypeName(arr(i)) = "Range" Then
            rngarr = Intersect(arr(i).Parent.UsedRange, arr(i))
        Else
            rngarr = arr(i)
        End If
        Dim j As Long
            For j = 1 To lgth
            If rngarr(j - IIf(LBound(rngarr, 1) = 0, 1, 0), 1) = arr(i   1) Then
                If i = LBound(arr) Then fnd(j) = True
            Else
                fnd(j) = False
            End If
            If i = UBound(arr) - 1 And fnd(j) Then
                myArrayMatch = j
                Exit Function
            End If
        Next j
    Next i
    
                
End Function

It can be called like:

relRow = myArrayMatch(ActiveSheet.Range("A:A"),"X",ActiveSheet.Range("B:B"),"Y")

The range/vertical array is the odd criterion and the value to search is the even.