Matching to columns from two tables and get info from other columns/tables VBA

[Green Squirrel]

My first question was "How do I match two columns form two different tables". @Akuini was so kind enough to help me with this. But now I struggle with the next step. Which is getting other info from matching lists.

The next issue is how do I get relevant info when there is a match.

Situation

Table1 on sheet1 has 4 columns.
Column1 has as name "Voornaam"
Column2 has as name "Familienaam"
Column3 has as name "DOB"
Column4 has as name "Plaats"

Table2 on sheet2 has also 4 columns.
Column1 has as name "First name"
Column2 has as name "Second name"
Column3 has as name "Geslacht"
Column2 has as name "Woonplaats"

Table3 on sheet3 has 2 columns
Column1 has as name "First name"
Column2 has as name "Leeftijd"

With my script I get the matches that I need.
So I get result when Sheet1.Table1.Column1 matches Sheet2.Table2.Column1 AND when Sheet1.Table1.Column2 matches Sheet2.Table2.Column2

So when there is a match I want to get the values of the columns below.

Sheet1 Table1 column3
Sheet1 Table1 column4
Sheet2 Table2 column3
Sheet2 Tabel2 column4
Sheet3 Table3 column2

Sub a1159025a()

Dim i As Long, k As Long
Dim va, vb, v1, v2
    
    va = Sheets("Sheet1").ListObjects("Table1").ListColumns("Voornaam").DataBodyRange.Resize(, 2)
    vb = Sheets("Sheet2").ListObjects("Table2").ListColumns("First name").DataBodyRange.Resize(, 2)
   
    ReDim v1(1 To UBound(va, 1), 1 To 1)
    ReDim v2(1 To UBound(vb, 1), 1 To 1)

    For i = 1 To UBound(va, 1)
        v1(i, 1) = va(i, 1) & "|" & va(i, 2)
    Next
    
    For i = 1 To UBound(va, 1)
        v2(i, 1) = vb(i, 1) & "|" & vb(i, 2)
    Next

ReDim vc(1 To UBound(va, 1), 1 To 2)

For i = LBound(v1) To UBound(v1)

     a = Application.Match(v1(i, 1), v2, 0)
     
     If IsNumeric(a) Then
        k = k + 1
        vc(k, 1) = Split(v2(a, 1), "|")(0)
        vc(k, 2) = Split(v2(a, 1), "|")(1)
     End If

Next i
    
    Sheet4.Range("D10:E100").ClearContents
    Sheet4.Range("D10").Resize(UBound(vc, 1), 2) = vc

End Sub

 

[Akuini]

So I get result when Sheet1.Table1.Column1 matches Sheet2.Table2.Column1 AND when Sheet1.Table1.Column2 matches Sheet2.Table2.Column2

Sheet3 Table3 column2

What's the match criteria for Table3?

 

[Green Squirrel]

What's the match criteria for Table3?

Column1

 

[Akuini]

Could you upload a sample workbook (without sensitive data) to a free site such as dropbox.com or google drive & then share the link here?
It will make it easier to test and find a solution.

 

[Green Squirrel]

I'll make some random data tonight and upload it for you

 

[Green Squirrel]

Hey, Seem to have issues sharing my google drive.

So I do it by pictures.

SHEET1

SHEET2

SHEET3

SHEET4 - Where the results come

 

[Akuini]

Ok, try this:

Sub a1159025b()

Dim i As Long, k As Long
Dim va, vb, v1, v2, vc, vf, vg, a, b
    
    va = Sheets("Sheet1").ListObjects("Table1").DataBodyRange
    vb = Sheets("Sheet2").ListObjects("Table2").DataBodyRange
    vf = Sheets("Sheet3").ListObjects("Table3").DataBodyRange
    vg = Sheets("Sheet3").ListObjects("Table3").DataBodyRange.Columns(1)
    
    ReDim v1(1 To UBound(va, 1), 1 To 1)
    ReDim v2(1 To UBound(vb, 1), 1 To 1)

    For i = 1 To UBound(va, 1)
        v1(i, 1) = va(i, 1) & "|" & va(i, 2)
    Next
    
    For i = 1 To UBound(va, 1)
        v2(i, 1) = vb(i, 1) & "|" & vb(i, 2)
    Next

ReDim vc(1 To UBound(va, 1), 1 To 6)

For i = LBound(v1) To UBound(v1)

     a = Application.Match(v1(i, 1), v2, 0)
     
     If IsNumeric(a) Then
        'find match in sheet3
        b = Application.Match(Split(v1(i, 1), "|")(0), vg, 0)
        
        If IsNumeric(b) Then

            k = k + 1
            'First name-Second name-DOB-Leeftijd-Plaats-Geslacht
            vc(k, 1) = Split(v2(a, 1), "|")(0)
            vc(k, 2) = Split(v2(a, 1), "|")(1)
            vc(k, 3) = va(i, 3)
            vc(k, 4) = vf(i, 2)
            vc(k, 5) = va(i, 4)
            vc(k, 6) = vb(i, 3)
        
        End If
     End If

Next i
    
    Sheet4.Range("D10:I100").ClearContents
    Sheet4.Range("D10").Resize(UBound(vc, 1), 6) = vc

End Sub

Note: next time you should use XL2BB add-in to post your data as table not image, so we don't have to retype sample.

 

[Green Squirrel]

Thank you very much!! This has been something I've been working on for weeks and it finally works! Big thank you

 

[Akuini]

@Green Squirrel
Actually the code is flawed, use this one instead:
Please test the code on many different data.

Sub a1159025c()

Dim i As Long, k As Long
Dim va, vb, v1, v2, vc, vf, vg, a, b
    
    va = Sheets("Sheet1").ListObjects("Table1").DataBodyRange
    vb = Sheets("Sheet2").ListObjects("Table2").DataBodyRange
    vf = Sheets("Sheet3").ListObjects("Table3").DataBodyRange
    vg = Sheets("Sheet3").ListObjects("Table3").DataBodyRange.Columns(1)
    
    ReDim v1(1 To UBound(va, 1), 1 To 1)
    ReDim v2(1 To UBound(vb, 1), 1 To 1)

    For i = 1 To UBound(va, 1)
        v1(i, 1) = va(i, 1) & "|" & va(i, 2)
    Next
    
    For i = 1 To UBound(vb, 1)
        v2(i, 1) = vb(i, 1) & "|" & vb(i, 2)
    Next

ReDim vc(1 To UBound(va, 1), 1 To 6)

For i = LBound(v1) To UBound(v1)

     a = Application.Match(v1(i, 1), v2, 0)
     
     If IsNumeric(a) Then
        'find match in sheet3
        b = Application.Match(Split(v1(i, 1), "|")(0), vg, 0)
        
        If IsNumeric(b) Then

            k = k + 1
            'First name-Second name-DOB-Leeftijd-Plaats-Geslacht
            vc(k, 1) = Split(v2(a, 1), "|")(0)
            vc(k, 2) = Split(v2(a, 1), "|")(1)
            vc(k, 3) = va(i, 3)
            vc(k, 4) = vf(b, 2)
            vc(k, 5) = va(i, 4)
            vc(k, 6) = vb(a, 3)
            
        
        End If
     End If

Next i
    
    Sheet4.Range("D10:I100").ClearContents
    Sheet4.Range("D10").Resize(UBound(vc, 1), 6) = vc

End Sub

 

[Green Squirrel]

Ok thanks.

I've just noticed something that I forgot

On Sheet2.Table2 I forgot a column in the table. So the match needs to be made with the 2nd column instead of the first. So vb needs to look for a match in the second column