VBA Consolidation Code

[danachu]

Hi all, I need help with a VBA Code. I have an excel table that looks like this:

[TABLE="class: cms_table, width: 1170"]
<tbody>[TR]
[TD="align: right"][/TD]
[TD][/TD]
[TD][TABLE="class: cms_table_grid, width: 500, align: left"]
<tbody>[TR]
[TD]PO[/TD]
[TD]Status[/TD]
[TD]Description[/TD]
[TD]Vendor[/TD]
[TD]Department[/TD]
[TD]Date Approved[/TD]
[TD]Project ID[/TD]
[TD]Before Tax[/TD]
[TD]Tax[/TD]
[TD]After Tax[/TD]
[TD]Invoice Number[/TD]
[TD]Invoice Date[/TD]
[TD]Invoice Amount[/TD]
[/TR]
[TR]
[TD]100012[/TD]
[TD]Closed[/TD]
[TD]Replenish Motors 1935.70[/TD]
[TD]AIT[/TD]
[TD]750[/TD]
[TD]2017-06-06T07:00:55[/TD]
[TD]2
[/TD]
[TD]30[/TD]
[TD]5[/TD]
[TD]35[/TD]
[TD]2000123[/TD]
[TD]7/23/2018[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]100012[/TD]
[TD]Closed[/TD]
[TD]Replenish Motors 1935.70[/TD]
[TD]AIT[/TD]
[TD]752[/TD]
[TD]2017-06-06T07:00:55[/TD]
[TD]2[/TD]
[TD]20[/TD]
[TD]4[/TD]
[TD]24[/TD]
[TD]2000123[/TD]
[TD]7/23/2018[/TD]
[TD]65[/TD]
[/TR]
</tbody>[/TABLE]

[/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
</tbody>[/TABLE]


I want to consolidate any of the rows that have the same PO numbers and make it look like the table below:
Basically, I want all the columns except for the Before Tax, Tax, and After Tax columns to be consolidated into one value. If the cell values in any of those columns don't match, I would like those values to both be represented in the corresponding combined cell, and separated by a comma (this is demonstrated in the Department column below). For the Before Tax, Tax, and After Tax columns, I would like the values to be added up and the row to just show the grand total. If someone could please help to formulate a VBA code that can do this that would be a huge help. Thank you!
[TABLE="class: cms_table_grid, width: 500, align: left"]
<tbody>[TR]
[TD]PO[/TD]
[TD]Status[/TD]
[TD]Description[/TD]
[TD]Vendor[/TD]
[TD]Department[/TD]
[TD]Date Approved[/TD]
[TD]Project ID[/TD]
[TD]Before Tax[/TD]
[TD]Tax[/TD]
[TD]After Tax[/TD]
[TD]Invoice Number[/TD]
[TD]Invoice Date[/TD]
[TD]Invoice Amount[/TD]
[/TR]
[TR]
[TD]100012[/TD]
[TD]Closed[/TD]
[TD]Replenish Motors 1935.70[/TD]
[TD]AIT[/TD]
[TD]750, 752[/TD]
[TD]2017-06-06T07:00:55[/TD]
[TD]2[/TD]
[TD]50[/TD]
[TD]9[/TD]
[TD]59[/TD]
[TD]2000123[/TD]
[TD]7/23/2018[/TD]
[TD]65

[/TD]
[/TR]
</tbody>[/TABLE]

​

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG01Aug42
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, ray [COLOR="Navy"]As[/COLOR] Variant, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
ray = Range("A1").CurrentRegion
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(ray, 1)
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(ray(n, 1)) [COLOR="Navy"]Then[/COLOR]
        ReDim nray(1 To UBound(ray, 2))
        [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(ray, 2)
            nray(Ac) = ray(n, Ac)
        [COLOR="Navy"]Next[/COLOR] Ac
        Dic.Add ray(n, 1), nray

    [COLOR="Navy"]Else[/COLOR]
        Q = Dic(ray(n, 1))
         [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(ray, 2)
            [COLOR="Navy"]If[/COLOR] Ac = 8 Or Ac = 9 Or Ac = 10 [COLOR="Navy"]Then[/COLOR]
                Q(Ac) = Q(Ac) + ray(n, Ac)
            [COLOR="Navy"]ElseIf[/COLOR] Not Q(Ac) = ray(n, Ac) [COLOR="Navy"]Then[/COLOR]
                 Q(Ac) = Q(Ac) & ", " & ray(n, Ac)
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac
        Dic(ray(n, 1)) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
c = c + 1
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Cells(c, 1).Resize(, UBound(Dic(K)))
        .Value = Dic(K)
        .ColumnWidth = 10
        .WrapText = True
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[danachu]

Hey Mick,

The code worked perfectly. Thank you very much!

Regards,

Vandana

 

[MickG]

You're welcome

 

[danachu]

Hi Mick,

I was wondering if you could modify the above code so that the invoice amount column is also added up to a grand total like the before tax, tax, and after tax columns.

 

[MickG]

No problem, Add code shown in Red !!

For Ac = 1 To UBound(ray, 2)
            If Ac = 8 Or Ac = 9 Or Ac = 10 [COLOR="#FF0000"][SIZE=3][B]Or Ac = 13 [/B][/SIZE][/COLOR]Then
                Q(Ac) = Q(Ac) + ray(n, Ac)
            ElseIf Not Q(Ac) = ray(n, Ac) Then
                 Q(Ac) = Q(Ac) & ", " & ray(n, Ac)
            End If
        Next Ac

 

[danachu]

Hi Mick,

The addition worked. Thank you so much!

 

[MickG]

You're welcome. Thanks for the feedback.