Consolidation of Two Separate Tables and Combining Duplicates

[maeyks]

I have a question. What if I have 2 separate tables and I want to extract data on both, combine them, but leaving the duplicate counted as one.

For <gs id="bc7b2acc-d060-4fb8-9ab1-a77ac0f6fe99" ginger_software_uiphraseguid="4d376d59-7c63-49a1-b562-f53ba9ec96e9" class="GINGER_SOFTWARE_mark">example on</gs> Table 1
Column A – Column B – Column C – C <gs id="a341fecc-ed38-4723-9c78-002dc83d145d" ginger_software_uiphraseguid="94dec487-0ecd-49a3-82d1-d48809a05e94" class="GINGER_SOFTWARE_mark">olumn</gs> D
Date – Item Number – Item Name – Quantity
July 1 – 0001 – Banana – 2
July 1 – 0002 – apple – 3
July 2 – 0001 – banana – 5
July 3 – 0003 – Mango – 6

For <gs id="afe94ed1-3ddf-4b74-8a22-1dcf04d32772" ginger_software_uiphraseguid="e49345c4-204b-4a52-af28-afc3e1c2552f" class="GINGER_SOFTWARE_mark">example on</gs> Table 2
Column A – Column B – Column C – C <gs id="164ade7c-fe80-4626-8ada-27d5efa7bfd4" ginger_software_uiphraseguid="7f3c0223-6802-45fe-9a38-1e96ec44b606" class="GINGER_SOFTWARE_mark">olumn</gs> D
Date – Item Number – Item Name – Quantity
July 1 – 0001 – Banana – 2 (duplicate)
July 4 – 0004 – melon – 7
July 2 – 0001 – banana – 5 (duplicate)
July 5 – 0008 – Lemon – 9

I want them to appear as:
Column A – Column B – Column C – C <gs id="e4943479-3338-48eb-82a4-b150f91b043d" ginger_software_uiphraseguid="5dc070b0-ebb5-4e7f-98ff-6d1cc786e29c" class="GINGER_SOFTWARE_mark">olumn</gs> D
Date – Item Number – Item Name – Quantity
July 1 – 0001 – Banana – 2 (duplicate)
July 1 – 0002 – apple – 3
July 4 – 0004 – melon – 7
July 2 – 0001 – banana – 5 (duplicate)
July 5 – 0008 – Lemon – 9
July 3 – 0003 – Mango – 6

Is there a way to do this?

Thank you.


Michael

 

[Takae]

Hope this helps.

Sub sample_maeyks()
    Dim Dic, i As Long, LastR As Long
    Dim buf As String, keys, ws As Worksheet
    Set Dic = CreateObject("scripting.Dictionary")
    On Error Resume Next
    For Each ws In Worksheets
        If ws.Name = "Table1" Or ws.Name = "Table2" Then
            With ws
                LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
                For i = 2 To LastR
                    buf = .Cells(i, 1).Value & "," & .Cells(i, 2).Value & "," & .Cells(i, 3).Value & "," & .Cells(i, 4).Value
                    Dic.Add buf, buf
                Next i
            End With
        End If
    Next
    With Sheets("Sheet3")
        keys = Dic.keys
        For i = 0 To Dic.Count - 1
            .Range(.Cells(i + 2, 1), .Cells(i + 2, 4)) = Split(keys(i), ",")
        Next i
        Set Dic = Nothing
        .Range("A1") = 1
        .Range("A1").Copy
        LastR = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range(.Range("A2"), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
         .Range("A1") = "Date"
    End With
End Sub

 

[Takae]

Sly a little

Sub sample_maeyks()
    Dim Dic, i As Long, LastR As Long
    Dim buf As String, keys, ws As Worksheet
    Set Dic = CreateObject("scripting.Dictionary")
    On Error Resume Next
    For Each ws In Worksheets
        If ws.Name = "Table1" Or ws.Name = "Table2" Then
            With ws
                LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
                For i = 2 To LastR
                    buf = .Cells(i, 1).Value & "," & .Cells(i, 2).Value & "," & .Cells(i, 3).Value & "," & .Cells(i, 4).Value
                    Dic.Add buf, buf
                Next i
            End With
        End If
    Next
    With Sheets("Sheet3")
        keys = Dic.keys
        For i = 0 To Dic.Count - 1
            .Range(.Cells(i + 2, 1), .Cells(i + 2, 4)) = Split(keys(i), ",")
        Next i
        Set Dic = Nothing
        .Range("A1") = 1
        .Range("A1").Copy
        LastR = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range(.Range("A2"), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
         .Range("A1") = "Date"
         Application.CutCopyMode = False
         .Range("A1").Activate
    End With
End Sub