Match 2 Columns and Result from 3rd Column

user_13301694 0
Viewed 252

Need help to compare (match) 2 columns from 2 sheets and return value from 3rd column of 2nd sheet if it matches.

    With Range("B3:B" & Range("A" & Rows.Count).End(xlUp).Row)
        .Formula = "=INDEX($D:$D,MATCH(1,(Sheet1!B$1=Sheet2!$C:$C)*(Sheet1!$A3=Sheet2!$A:$A),0))"
        .Value = .Value
    End With

Sheet 1:

enter image description here

Sheet 2:

enter image description here

This Function is taking longer than usual if I place formula in each cell (for whole month). so trying this With function but needs a better code which should run faster. Any suggestions ..

multiple-columns compare vba excel
3 Answers

Match Columns Using a Dictionary of Dictionaries

Sub MatchColumns()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet2")
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' ("A1:D13")
    Dim rCount As Long: rCount = srg.Rows.Count - 1
    Dim Data As Variant: Data = srg.Resize(rCount).Offset(1).Value ' ("A2:D13")
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim Key As Variant
    Dim r As Long

    For r = 1 To rCount
        Key = Data(r, 1)
        If Not dict.Exists(Key) Then
            Set dict(Key) = CreateObject("Scripting.Dictionary")
        End If
        dict(Key)(Data(r, 3)) = Data(r, 4)
    Next r
    
    ' Print the contents of the dictionary in the Immediate window (Ctrl+G).
'    Dim iKey As Variant
'    For Each Key In dict.Keys
'        Debug.Print Key
'        For Each iKey In dict(Key).Keys
'            Debug.Print iKey
'        Next iKey
'    Next Key
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1")
    
    Dim drrg As Range ' The Row (Column Labels, Headers) ' ("B1:E1")
    Set drrg = dws.Range("B1", dws.Cells(1, dws.Columns.Count).End(xlToLeft))
    Dim rData As Variant: rData = drrg.Value
    Dim cCount As Long: cCount = drrg.Columns.Count
    
    Dim dcrg As Range ' The Column (Row Labels) ' ("A3:A5")
    Set dcrg = dws.Range("A3", dws.Cells(dws.Rows.Count, "A").End(xlUp))
    Dim cData As Variant: cData = dcrg.Value
    rCount = dcrg.Rows.Count
    
    ReDim Data(1 To rCount, 1 To cCount)
    
    Dim c As Long
    
    For r = 1 To rCount
        Key = cData(r, 1)
        If dict.Exists(Key) Then
            For c = 1 To cCount
                If dict(Key).Exists(rData(1, c)) Then
                    Data(r, c) = dict(Key)(rData(1, c))
                End If
            Next c
        End If
    Next r
    
    dws.Range("B3").Resize(rCount, cCount).Value = Data ' ("B3:E5")
    
End Sub
user_98140690

If you have Excel 365 you can make this easily with FILTER:

enter image description here

My formula in cell G4 is:

=FILTER($D$2:$D$13;($A$2:$A$13=$F4)*($C$2:$C$13=G$2))

Drag to right and down

If you don't have Excel 365 you can do it with a complext formula:

=INDEX($D$1:$D$13;SUMPRODUCT(--($A$2:$A$13=$F4)*--($C$2:$C$13=G$2)*FILA($D$2:$D$13)))

Notice that the part SUMPRODUCT(--($A$2:$A$13=$F4)*--($C$2:$C$13=G$2)*FILA($D$2:$D$13)) will return the absolute row number of where the data is located so in INDEX you need to reference the whole column or substract properly (that's why I chose from row 1 including headers as first argument of INDEX).

user_91998280

This uses an array formula to populate B3:E6 simultaneously

With Sheet1.Range("B3:E" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)
    .FormulaArray = "=INDEX(Sheet2!$D$2:$D$13,MATCH(Sheet1!A3:A5&Sheet1!B1:E1,Sheet2!A2:A13&Sheet2!C2:C13,0))"
    .Value2 = .Value2
End With
user_188247270
Related