Excel Sum Rows Remove Duplcates

The following Excel VBA procedure will group like data together and sum it, removing any duplication in a neat little summary.  On the Excel forums this is quite a common request.  This is traditionally handled with an Excel table or a pivot table.  However what happens if you have 50, 60 160 columns to sum.  Adding each field into a pivot table is not really tenable.  A quick solution is to get VBA to do the job for you.  I would not recommend this as part of a regular reporting routine but is handy to get fast summary data.

Here is an example of where i have used it to help someone on the Chandoo forum.

SumData

The technique uses  the scripting dictionary which is very useful as it will only allow a unique key, which is our unique identifier.  The following is some sample data I have colour coded.  Each change represents the new set of unique identifiers (which match the dientifyers shown in the data above).  See column 3, 101,102 etc.

The following is the Excel VBA code which remove all duplicates while summarising the calculated fields in your Excel dataset.

Option Explicit

Sub SumandRemove() 'Excel VBA code to sum rows and remove duplicates.
Dim ar As Variant
Dim i As Long
Dim j As Long
Dim n As Long
Dim str As String

n=1
ar=Sheet1.Cells(10, 1).CurrentRegion.Value 'Data starts in Row 10 of my Excel model.
With Createobject("Scripting.Dictionary")
For i=2 To UBound(ar, 1)
str=ar(i, 3) 'The unique value is in the 3rdcolumn
If Not .exists(str) Then
n=n + 1
For j=1 To UBound(ar, 2)
ar(n, j)=ar(i, j)
Next j
.Item(str)=n
Else
For j=7 To UBound(ar, 2) 'In this example the numbers start in Column 7
ar(.Item(str), j)=ar(.Item(str), j) + ar(i, j)
Next j
End If
Next i
End With
Sheet2.Range("A1").Resize(n, UBound(ar, 2)).Value=ar
End Sub

Breaking the code down the following line says we will start the loop on row 2 till the last used row.

For i=2 To UBound(ar, 1)

The next important bit of information is the unique identifier, the item you wish to use to consolidate all like items.

For i=2 To UBound(ar, 1)

The Excel file attached shows the procedure using a practical example of this scripting dictionary technique.

str=ar(i, 3)

The above takes the item in column 3, so if your unique identifier were in column 1, then change this line to

str=ar(i, 1)

Finally the last bit of important information is which columns to add together. In my example the columns I am consolidating start in column G or column 7.

For j=7 To UBound(ar, 2)

in the above example 7 is for column 7 and the upper bound part of the line of VBA code is for every column after 7. So it is important to only include columns you wish to consolidate. In my example there are only 8 columns so both 7 and 8 are consolidated based on the unique identifier. If there were 50 or 150 columns the code would work just as efficiently. It is the

UBound(ar, 2)

part which gives the VBA code its flexibility. If the cells you want to consolidate are between say columns 6 and 10 and you don't want to consolidate data after column 10, just change the line to the following:

For j=6 To 10

So in summary to modify this code there are only 3 elements which need to change. I have tried to keep this as simple as possible so it can be manipulated for other data sets. The Excel file below has the example explained above with the VBA coding to go with the model.