Merge Two Tables and Convert to Data List

Gimics

Board Regular
Joined
Jan 29, 2014
Messages
164
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have two tables that are maintained separately, but share common elements. Based on those common elements, I would like to merge the tables and extend them into a full data list.

The first table has headings across the top (let's call them location groups) that need to be looked up in the second table, which will contain multiple records (let's called them locations) of those headings associated with additional fields. After looking the value up, I want to create a third table that's a list of all of the source data and looked up values. Much easier to explain with visuals:

Table 1(source data):
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Fruit Types[/TD]
[TD="align: center"]Stores[/TD]
[TD="align: center"]Ecommerce[/TD]
[TD="align: center"]Corporate[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Gala[/TD]
[TD]Fuji[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Orange[/TD]
[TD]Tangerine[/TD]
[TD]Mandarin[/TD]
[TD]Madarin[/TD]
[/TR]
</tbody>[/TABLE]


Table 2(mapping table):
[TABLE="class: grid, width: 400"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Location Groups[/TD]
[TD]Locations[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Stores[/TD]
[TD]Store 100[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Stores[/TD]
[TD]Store 200[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Stores[/TD]
[TD]Store 300[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Ecommerce[/TD]
[TD]Canada Website[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Ecommerce[/TD]
[TD]USA Website[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Ecommerce[/TD]
[TD]Global Website[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Corporate[/TD]
[TD]Head Office[/TD]
[/TR]
</tbody>[/TABLE]


Table 3(output; for each fruit type and fruit variety, lookup location group and create a record for each location):
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]Fruit Types[/TD]
[TD="align: center"]Fruit Variety[/TD]
[TD="align: center"]Location Group[/TD]
[TD="align: center"]Location[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Stores[/TD]
[TD]Store 100[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Stores[/TD]
[TD]Store 200[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Stores[/TD]
[TD]Store 300[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Ecommerce[/TD]
[TD]Canada Website[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Ecommerce[/TD]
[TD]USA Website[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Ecommerce[/TD]
[TD]Global Website[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Apple[/TD]
[TD]Fuji[/TD]
[TD]Corporate[/TD]
[TD]Head Office[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]Orange[/TD]
[TD]Tangerine[/TD]
[TD]Stores[/TD]
[TD]Store 100[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Orange[/TD]
[TD]Tangerine[/TD]
[TD]Stores[/TD]
[TD]Store 200[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Orange[/TD]
[TD]Tangerine[/TD]
[TD]Stores[/TD]
[TD]Store 300[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]Orange[/TD]
[TD]Mandarin[/TD]
[TD]Ecommerce[/TD]
[TD]Canada Website[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]Orange[/TD]
[TD]Mandarin[/TD]
[TD]Ecommerce[/TD]
[TD]USA Website[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]Orange[/TD]
[TD]Mandarin[/TD]
[TD]Ecommerce[/TD]
[TD]Global Website[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]Orange[/TD]
[TD]Mandarin[/TD]
[TD]Corporate[/TD]
[TD]Head Office[/TD]
[/TR]
</tbody>[/TABLE]

I have many more columns and rows of data, but this basic layout would solve my problem. I know how to look through the source table and then how to update the output table with those values, but I don't know how to find multiple values in the mapping table and return multiple values.

Say I've declared variables for the source table (Table1) and mapping table (Table2), including their rows, columns and data, and selected an output range for Table3 as a single cell (outRng); this would roughly be where I'm at (the code below isn't complete for all of the headings, but I can figure that part out...this is just for the mapping lookup):

Code:
For i = 1 to Table1.rows.count
    For j = 1 To Table1.columns.count
        If Not Table1.body(i, j) = "" Then
            Set foundRng = Table2Groups.Find(Table1Heading(,j), LookIn:=xlValues)
            outRng.Offset(k - 1).Resize(foundRng.Rows.Count).Value = foundRng.Offset(, 1).Value
            k = k + foundRng.Rows.Count
        Else
        End If
    Next j
Next i

This, obviously, only returns one value, as range.find only returns the range of the first found cell. This would be my resulting table:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD="align: center"]Fruit Types[/TD]
[TD="align: center"]Fruit Variety[/TD]
[TD="align: center"]Location Group[/TD]
[TD="align: center"]Location[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Stores[/TD]
[TD]Store 100[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Apple[/TD]
[TD]Gala[/TD]
[TD]Ecommerce[/TD]
[TD]Canada Website[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Apple[/TD]
[TD]Fuji[/TD]
[TD]Corporate[/TD]
[TD]Head Office[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Orange[/TD]
[TD]Tangerine[/TD]
[TD]Stores[/TD]
[TD]Store 100[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Orange[/TD]
[TD]Mandarin[/TD]
[TD]Ecommerce[/TD]
[TD]Canada Website[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Orange[/TD]
[TD]Mandarin[/TD]
[TD]Corporate[/TD]
[TD]Head Office[/TD]
[/TR]
</tbody>[/TABLE]


What am I missing? It would be great if I could use a range.resize(foundrange.size) = foundrange.offset(1) kind of formula here, but maybe I can only do this with multiple loops?

Thanks in advance!
 
Last edited:
So if you have 3 tables, try this macro

Change data in red by your information

A small change:

Code:
Sub Convert_Data_List()
    Dim lo1 As ListObject, lo2 As ListObject, lo3 As ListObject
    Dim elem As Range, b As Range, sh As Worksheet
    Dim j As Long, cell As String, n As Long
    
    Application.ScreenUpdating = False
    Set sh = Sheets("[COLOR=#ff0000]Data[/COLOR]")
    Set lo1 = sh.ListObjects("[COLOR=#ff0000]Source[/COLOR]")
    Set lo2 = sh.ListObjects("[COLOR=#ff0000]mapping[/COLOR]")
    Set lo3 = sh.ListObjects("[COLOR=#ff0000]output[/COLOR]")
    
    With lo3.DataBodyRange
        If .Rows.Count > 1 Then .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        .Rows(1).ClearContents
    End With
    
    For Each elem In lo1.ListColumns(1).DataBodyRange
        For j = 2 To lo1.ListColumns.Count
            Set b = lo2.Range.Find(lo1.HeaderRowRange(, j), LookAt:=xlWhole)
            If Not b Is Nothing Then
                cell = b.Address
                Do
                    n = lo3.DataBodyRange.Rows.Count
                    [COLOR=#ff0000]lo3.DataBodyRange(n, 1).Resize(1, 4).Value = Array(elem, elem.Offset(, j - 1), b, b.Offset(, 1))[/COLOR]
                    
                    lo3.ListRows.Add AlwaysInsert:=True
                    Set b = lo2.Range.FindNext(b)
                Loop While Not b Is Nothing And b.Address <> cell
            End If
        Next
    Next
End Sub
 
Upvote 0

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Well, I put the code for 3 sheets, assumes that your information starts in cell A1 for the 3 sheets.

Code:
Sub Convert_Data_List2()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, elem As Range, head As Range, n As Long
    
    Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
    Set sh2 = Sheets("[COLOR=#ff0000]Sheet2[/COLOR]")
    Set sh3 = Sheets("[COLOR=#ff0000]Sheet3[/COLOR]")
    sh3.Rows("2:" & Rows.Count).ClearContents
    
    For Each elem In sh1.Range("A2", sh1.Range("A" & Rows.Count).End(xlUp))
        For Each head In sh1.Range("B1", sh1.Cells(1, Columns.Count).End(xlToLeft))
            sh2.Range("A1").AutoFilter 1, head
            n = Application.CountA(sh2.AutoFilter.Range.Columns(1).Offset(1).SpecialCells(xlCellTypeVisible))
            sh2.AutoFilter.Range.Offset(1).Copy sh3.Range("C" & Rows.Count).End(xlUp)(2)
            sh3.Range("A" & Rows.Count).End(xlUp)(2).Resize(n, 2).Value = Array(elem, sh1.Cells(elem.row, head.Column))
        Next
    Next
End Sub
 
Upvote 0
Thanks all for the responses!

As the data will be changing periodically, I was really focused on a VBA answer to assist with automation.

I actually have a combination of tables (real, formatted) and data ranges, so I had to combine a few suggestions.

I went with lrobbo314's approach in creating an arraylist and then transposing the list to a destination - I'd never used this before and your code looked so clean, so I thought I would try it out!

I made a couple of tweaks to facilitate using ranges and tables and the additional header rows I had, but it worked first try exactly as I wanted.

One thing I was a little hung up on was the .texttocolumns resulting in numeric values (I left that part out in my description) being truncated if they're too long, as is always the case with text to columns. I just added a fieldinfo:=array(1,2)... etc for all of the columns to be formatted as text.

At the end of the day, it's still just looping through the mapping table to join all of the values, where it can find joinable values. I was worried about performance, but even with my output range being 35,000 records, the macro runs in seconds.

Thanks again!
 
Upvote 0
Thanks all for the responses!

As the data will be changing periodically, I was really focused on a VBA answer to assist with automation.

I actually have a combination of tables (real, formatted) and data ranges, so I had to combine a few suggestions.

I went with lrobbo314's approach in creating an arraylist and then transposing the list to a destination - I'd never used this before and your code looked so clean, so I thought I would try it out!

I made a couple of tweaks to facilitate using ranges and tables and the additional header rows I had, but it worked first try exactly as I wanted.

One thing I was a little hung up on was the .texttocolumns resulting in numeric values (I left that part out in my description) being truncated if they're too long, as is always the case with text to columns. I just added a fieldinfo:=array(1,2)... etc for all of the columns to be formatted as text.

At the end of the day, it's still just looping through the mapping table to join all of the values, where it can find joinable values. I was worried about performance, but even with my output range being 35,000 records, the macro runs in seconds.

Thanks again!

I'm glad you found a solution, just in case there are other codes that maybe can serve as a guide for another situation.
Greetings and thanks for the feedback.
 
Upvote 0
I really like Sandy’s solution. I originally tried to do it via power query, but since I’m better with VBA, I leaned on that crutch. It seemed so simple once I saw how sandy did it. Always nice to see the multiple solutions.

Happy to hear that you got a solution that works for you.
 
Upvote 0
Hey all - just an update for an issue I hadn't identified (mostly for future use cases of people who might stumble across this).

When transposing the array into excel cells, Excel thought all of the values were the same numeric value if the strings were all filled with numeric values.

In lroobo's second post, if the Fruit, fType, cHead, and T2.DataBodyRange.cells(k,2) values were all numeric, excel would transpose them as a number, without the comma delimiter we had inserted as part of his "xJoin" function.

To get around this, I added quotes around all of the strings (which is common practice with formatted comma separated value files (.csv)).

I've updated his code to show what this looked like and also included my updates to the text-to-columns method to format the output as text as mentioned in my prior post (see changes in red):

Same thing but adjusted to use tables instead of loading ranges to arrays.

Code:
Sub Combo2()
Dim T1 As ListObject: Set T1 = Sheets("Sheet1").ListObjects("Table1")
Dim T2 As ListObject: Set T2 = Sheets("Sheet1").ListObjects("Table2")
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim Fruit As String, fType As String, cHead As String


AL.Add xJoin("[COLOR=#ff0000]""[/COLOR],[COLOR=#ff0000]""[/COLOR]", [COLOR=#ff0000]""[/COLOR]"Fruit Types", "Fruit Variety", "Location Group", "Location"[COLOR=#ff0000]""[/COLOR])


For i = 1 To T1.DataBodyRange.Rows.Count
    Fruit = T1.DataBodyRange.Cells(i, 1)
    For j = 2 To T1.DataBodyRange.Columns.Count
        cHead = T1.HeaderRowRange.Cells(1, j)
        fType = T1.DataBodyRange(i, j)
        For k = 1 To T2.DataBodyRange.Rows.Count
            If T2.DataBodyRange.Cells(k, 1) = cHead Then
                AL.Add xJoin("[COLOR=#ff0000]""[/COLOR],[COLOR=#ff0000]""[/COLOR]", [COLOR=#ff0000]"""" & [/COLOR]Fruit, fType, cHead, T2.DataBodyRange.Cells(k, 2) [COLOR=#ff0000]& """"[/COLOR])
            End If
        Next k
    Next j
Next i


With Range("R1").Resize(AL.Count) 'Change this range for where you want your results to show up
    .Value = Application.Transpose(AL.toArray)
    .TextToColumns DataType:=xlDelimited, Comma:=True, [COLOR=#ff0000]FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2))[/COLOR]
End With


End Sub


Function xJoin(del As String, ParamArray arg() As Variant) As String
xJoin = Join(arg, del)
End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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