vba - How to combine 2 tables into one table and sum the price if the item code are the same in excel?

Question

Hi everyone,

I want to combine Table 1 and Table 2 into one table (Table 3). If the Item Code 1 and Item code 2 are the same, then sum the price. The final output should be something like Table 3. I'm not sure whether this can be done without VBA or not, preferably not using VBA. However, VBA is still fine if there is no way for excel function to perform this grouping task. Any advice will be greatly appreciated, thank you!

question from:https://stackoverflow.com/questions/65841483/how-to-combine-2-tables-into-one-table-and-sum-the-price-if-the-item-code-are-th

Answer 1

Please, try the next code:

Sub JoinTables()
  Dim sh As Worksheet, T1 As ListObject, T2 As ListObject, T3 As ListObject
  Dim arr1, arr2, arr3, arrHead, dict As Object, i As Long, iRow As Long, iCol As Long
  
  Set sh = ActiveSheet 'use here the necessary sheet
  Set T1 = sh.ListObjects("Table1") 'use here your first table name
  Set T2 = sh.ListObjects(2)        'use here your second table name
  
  arr1 = T1.DataBodyRange.Value     'put the data body range in an array
  arr2 = T2.DataBodyRange.Value
  arrHead = T1.HeaderRowRange.Value 'put thea header in an array
  
  Set dict = CreateObject("Scripting.Dictionary") 'create a dictionary
  For i = 1 To UBound(arr1)
    dict(arr1(i, 1)) = arr1(i, 2) 'input all in the dictionary
  Next i
  
  For i = 1 To UBound(arr2)  'process the second table, too
    If Not dict.Exists(arr2(i, 1)) Then
        dict(arr2(i, 1)) = arr2(i, 2) 'create a new key
    Else
        dict(arr2(i, 1)) = dict(arr2(i, 1)) + arr2(i, 2) 'add to the existing key
    End If
  Next i

  'interesting way of obtaining an array by other (one column) arrays combination:
  arr3 = Application.Transpose(Array(dict.Keys, dict.Items)) 'combine the two array !!!

  iRow = T1.HeaderRowRange.row 'the row where the new Table will be created
  iCol = T2.HeaderRowRange.Column + T2.HeaderRowRange.Columns.count 'column of the new table

  sh.Range(sh.cells(iRow, iCol + 1), sh.cells(iRow, iCol + 2)).Value = arrHead 'put the header
  sh.cells(iRow, iCol + 1).Offset(1).Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3 'put the content
  sh.cells(iRow, iCol + 1).CurrentRegion.Select 'select it to become a table in the next code line

  Set T3 = sh.ListObjects.Add  'create the new table
  'Copy the second column format in the new created table
  T3.DataBodyRange.Columns(2).NumberFormat = T1.DataBodyRange.Columns(2).NumberFormat
End Sub

Edited to ad a version working with ranges:

Sub MergeRanges()
  Dim sh As Worksheet, lastR1 As Long, lastR2 As Long, firstCol1 As Long, firstCol2 As Long
  Dim arr1, arr2, arr3, arrHead, dict As Object, i As Long, iRow As Long, iCol As Long
  
  Set sh = ActiveSheet 'use here the necessary sheet
  firstCol1 = 7: firstCol2 = 10 'where are the first column of the two ranges
  iRow = 14                     ' the row where the header is
  
  lastR1 = sh.cells(rows.count, firstCol1).End(xlUp).row
  lastR2 = sh.cells(rows.count, firstCol2).End(xlUp).row
  
  arr1 = sh.Range(sh.cells(iRow + 1, firstCol1), sh.cells(lastR1, firstCol1 + 1)).Value 'put the range in an array
  arr2 = sh.Range(sh.cells(iRow + 1, firstCol2), sh.cells(lastR2, firstCol2 + 1)).Value
  arrHead = sh.Range(sh.cells(iRow, firstCol1), sh.cells(iRow, firstCol1 + 1)).Value  'put thea header in an array
  
  Set dict = CreateObject("Scripting.Dictionary") 'create a dictionary
  For i = 1 To UBound(arr1)
    dict(arr1(i, 1)) = arr1(i, 2) 'input all in the dictionary
  Next i
  
  For i = 1 To UBound(arr2)
    If Not dict.Exists(arr2(i, 1)) Then
        dict(arr2(i, 1)) = arr2(i, 2) 'create a new key
    Else
        dict(arr2(i, 1)) = dict(arr2(i, 1)) + arr2(i, 2) 'add to the existing key
    End If
  Next i
  
  arr3 = Application.Transpose(Array(dict.Keys, dict.Items)) 'combine the two array !!!

  iCol = firstCol2 + 3 'column of the new table
  
  sh.Range(sh.cells(iRow, iCol + 1), sh.cells(iRow, iCol + 2)).Value = arrHead 'put the header
  With sh.cells(iRow, iCol + 1).Offset(1).Resize(UBound(arr3), UBound(arr3, 2))
    .Value = arr3 'put the content
    .Columns(2).NumberFormat = sh.cells(iRow + 1, firstCol1 + 1).NumberFormat
  End With
End Sub