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

Green Squirrel

New Member
Joined
Jan 9, 2021
Messages
25
Office Version
  1. 365
Platform
  1. MacOS
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

VBA Code:
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
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Ok, I think I understand the requirement from post #16. So you don't need to create the result table.
 
Upvote 0
Can you show me the header of the result table? It would be 10 columns?
 
Upvote 0
Try this:
VBA Code:
Sub a1159042c()
'https://www.mrexcel.com/board/threads/matching-to-columns-from-two-tables-and-get-info-from-other-columns-tables-vba.1159042/
Dim i As Long, j As Long, n As Long
Dim ra As Range, rb As Range, rc As Range, rd As Range
Dim tx As String
Dim va, vb

Set ra = Sheets("Sheet1").ListObjects("Table1").DataBodyRange
Set rb = Sheets("Sheet2").ListObjects("Table2").DataBodyRange
Set rc = Sheets("Sheet3").ListObjects("BEhome").DataBodyRange
Set rd = Sheets("Sheet3").ListObjects("BEaway").DataBodyRange


va = rb
ReDim vb(1 To rb.Rows.Count, 1 To 10)

For i = 1 To UBound(va, 1)
        a = Application.Match(va(i, 2), ra.Columns(1), 0)
        b = Application.Match(va(i, 3), ra.Columns(1), 0)

            If IsNumeric(a) And IsNumeric(b) Then
            k = k + 1
                 vb(k, 1) = rb(i, 1) 'Date
                 vb(k, 2) = ra(a, 2) 'League
                 
                 vb(k, 3) = va(i, 2)   'Home team
                 vb(k, 4) = ra(a, 3)  'Home League
                 
                 vb(k, 7) = va(i, 3)   'Away team
                 vb(k, 8) = ra(b, 4)  'Away League
                    
                    c = Application.Match(va(i, 2), rc.Columns(1), 0)
                    d = Application.Match(va(i, 3), rd.Columns(1), 0)
                 
                If IsNumeric(c) And IsNumeric(d) Then

                 'SHEET3.TABLE("BEhome")
                 vb(k, 5) = rc(c, 2)
                 vb(k, 6) = rc(c, 3)
                 
                 'SHEET3.TABLE("BEaway")
                 vb(k, 9) = rd(d, 2)
                 vb(k, 10) = rd(d, 3)
                End If

            End If
Next

Sheets("Sheet4").Range("A1").CurrentRegion.Offset(1).ClearContents
Sheets("Sheet4").Range("A2").Resize(UBound(vb, 1), 10) = vb
End Sub

RESULT:
Green Squirrel - 1159042 - 1.xlsm
ABCDEFGHIJ
1
2Tue 21 Jan 20:00Belgium - Jupiler LeagueAnderlechtBEhome111KortrijkBEaway2010
3Tue 19 Jan 20:00Belgium - Jupiler LeagueAntwerpBEhome212KRC GenkBEaway2111
4Tue 19 Jan 20:00Belgium - Jupiler LeagueBeerschot-Wil.BEhome313KV MechelenBEaway2212
5Tue 19 Jan 20:00Belgium - Jupiler LeagueBeverenBEhome414MouscronBEaway2313
6Tue 19 Jan 20:00Belgium - Jupiler LeagueCercle BruggeBEhome515OH LeuvenBEaway2414
7Tue 19 Jan 20:00Belgium - Jupiler LeagueCharleroiBEhome616OostendeBEaway2515
8Tue 20 Jan 20:00Belgium - Jupiler LeagueClub BruggeBEhome717Sint-TruidenBEaway2616
9Tue 19 Jan 20:00Belgium - Jupiler LeagueEupenBEhome817Standard LiegeBEaway2717
10Tue 19 Jan 20:00Belgium - Jupiler LeagueGentBEhome919Zulte-WaregemBEaway2818
Sheet4
 
Upvote 0
Solution

Forum statistics

Threads
1,213,557
Messages
6,114,293
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top