Excel VBA to match multiple columns and get value-CodePudding

What I'm trying to do is match values at 2 different tables and to copy the value in a destination table. I understand this requires multiple loops / conditions, which I am struggling with.

The goal ist copying the matching values from source table (SE) to each row in destination table (FB) using the match in the helper table (SA).

This picture shows what I want to achive: Tables.jpg

To note there a no unique key values in column 'C' at table 'SA'.

My code so far is as follows:

Sub MatchTables()


    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim i As Long, j As Long
    Dim newSheetPos As Integer

    Set ws1 = ActiveWorkbook.Sheets("FB") 'Range: last row
    Set ws2 = ActiveWorkbook.Sheets("SA") 'Range: rows 5 to 84
    Set ws3 = ActiveWorkbook.Sheets("SE") 'Range: last row

    For i = 2 To ws1.Cells(ws1.Rows.Count, 3).End(xlUp).Row
        For j = 5 To 84

            If ws1.Cells(i, 3).Value = ws2.Cells(j, 3).Value Then

                If ws2.Cells(i, 3).Value = ws3.Cells(j, 5).Value Then
                    ws3.Cells(j, 6).Copy ws1.Cells(i , 16)
                Else
                End If
            Else
            End If

        Next j
    Next i
End Sub

Many thanks for your help.

CodePudding user response：

(Super) Double Lookup

To simplify, it is assumed that each of the lookup columns contains at least 2 rows of data and no error values or blanks.

Sub SuperLookup()

    Const sName As String = "SE"
    Const sfRow As Long = 2
    Const slCol As String = "E" ' 4.) ... here and return...
    Const svCol As String = "F" ' 5.) ... this...
    
    Const lName As String = "SA"
    Const lRowsAddress As String = "5:84"
    Const llCol As String = "C" ' 2.) ... here and return...
    Const lvCol As String = "Q" ' 3.) ... this to look it up...
    
    Const dName As String = "FB"
    Const dfRow As Long = 2
    Const dlCol As String = "C" ' 1.) Look up this...
    Const dvCol As String = "P" ' 6.) ... here.
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, slCol).End(xlUp).Row
    Dim srg As Range
    Set srg = sws.Cells(sfRow, slCol).Resize(slRow - sfRow   1)
    Dim sData As Variant: sData = srg.EntireRow.Columns(svCol).Value
    
    Dim lws As Worksheet: Set lws = wb.Worksheets(lName)
    Dim lrg As Range: Set lrg = lws.Rows(lRowsAddress).Columns(llCol)
    Dim lData As Variant: lData = lrg.EntireRow.Columns(lvCol).Value
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dlCol).End(xlUp).Row
    Dim drCount As Long: drCount = dlRow - dfRow   1
    Dim drg As Range: Set drg = dws.Cells(dfRow, dlCol).Resize(drCount)
    Dim dlData As Variant: dlData = drg.Value
    Set drg = drg.EntireRow.Columns(dvCol)
    Dim dvData As Variant: ReDim dvData(1 To drg.Rows.Count, 1 To 1)
    
    Dim sIndex As Variant
    Dim lIndex As Variant
    Dim lValue As Variant
    Dim dValue As Variant
    Dim dr As Long
    
    For dr = 1 To drCount
        dValue = dlData(dr, 1)
        lIndex = Application.Match(dValue, lrg, 0)
        If IsNumeric(lIndex) Then
            lValue = lData(lIndex, 1)
            sIndex = Application.Match(lValue, srg, 0)
            If IsNumeric(sIndex) Then
                dvData(dr, 1) = sData(sIndex, 1)
            'Else ' not found in source; do nothing
            End If
        'Else ' not found in lookup; do nothing
        End If
    Next dr

    drg.Value = dvData
    
    MsgBox "Super lookup has finished.", vbInformation

End Sub