Consolidate, merge and sum values in vba

Question

I have a table which has duplicates of the same person and I'm wanting to merge these down into a single row whilst summing up two columns assigned to each row of data.

For example:

I am wanting to merge the data in columns A to D by using column A as my 'reference point' on what to match. I then want the values to be added together in Columns E and F. Giving me the results below.

I'm sure there is a simple solution to this but I'm pretty new to VBA and haven't come across anything.

Thanks

[Pivot Table](https://support.office.com/en-us/article/Create-a-PivotTable-to-analyze-worksheet-data-A9A84538-BFE9-40A9-A8E9-F99134456576) to the rescue! — Scott Holtzman, Nov 23 '17 at 11:26
I want this to be done automatically as part of a process and so want to do it with VBA. — jufg, Nov 23 '17 at 11:48
So record yourself building a pivot table and you'll have a vba solution — Harassed Dad, Nov 23 '17 at 13:30

score 0 · Answer 1 · answered Nov 23 '17 at 13:46

This can be accomplished using the following code:

Sub foo()
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
    Sheet1.Cells(x, 7).Value = "=SUMIF(R1C1:R17C6,RC[-6],C[-2])"
    Sheet1.Cells(x, 8).Value = "=SUMIF(R1C1:R17C6,RC[-7],C[-2])"
Next x

Range("G2:H" & LastRow).Copy
Range("G2:H" & LastRow).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("E2:F" & LastRow).Delete Shift:=xlToLeft
Sheet1.Range("$A$1:$H$" & LastRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8), Header:=xlNo
End Sub

In essence, the code sums all the values in column G & H then copies and paste as values (to get rid of the formulas on the cells) then deletes the contents from columns E & F, shifting to the left to bring the new values to the right columns, and finally it removes any duplicates to give you the compiled list as you wanted.

Consolidate, merge and sum values in vba

1 Answers1