Sum duplicate row data and keep only 1 row

[Excel_Blonde]

Hi there,

I'm trying to manipulate some code (At bottom) I found within another thread on this site to meet my personal requirements.

Can someone explain what the various bits do please?

(Additional Info: I have a file with 28 columns (A:AF), I'm trying to look at 3 columns (A, F & H) and if the data in all 3 match any other rows I want to sum the value from multiple columns (E, R:U, W:X) and delete all rows except from one. The example below gives an indication of what I'm trying to achieve but doesn't reflect exactly how my data is presented.)

[TABLE="width: 500"]
<tbody>[TR]
[TD]Ref1[/TD]
[TD]#to sum[/TD]
[TD]Ref2[/TD]
[TD]#to sum[/TD]
[TD]Ref3[/TD]
[TD]#to sum[/TD]
[TD]#to sum[/TD]
[TD]Expected Action[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]A[/TD]
[TD][/TD]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]A[/TD]
[TD][/TD]
[TD]20[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]A[/TD]
[TD][/TD]
[TD]30[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]B[/TD]
[TD][/TD]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD]All 3 columns match Row below so Merge/sum[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]B[/TD]
[TD][/TD]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD]All 3 columns match row above so Merge/sum with row above and delete row[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]B[/TD]
[TD][/TD]
[TD]20[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]A[/TD]
[TD][/TD]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]A[/TD]
[TD][/TD]
[TD]20[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD]A[/TD]
[TD][/TD]
[TD]30[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



Sub CombineSumDuplicates_RegNbr()
' hiker95, 09/18/2016, ME965464
Dim lr As Long, r As Long, n As Long, t As Double
Application.ScreenUpdating = False
With Sheets("Sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
n = Application.CountIf(.Columns(2), .Cells(r, 2).Value)
If n > 1 Then
t = Application.Sum(.Cells(r, 4), .Cells(r + n - 1, 4))
.Cells(r, 4).Value = t
t = Application.Sum(.Cells(r, 5), .Cells(r + n - 1, 5))
.Cells(r, 5).Value = t
.Range(.Cells(r + 1, 1), .Cells(r + n - 1, 5)).ClearContents
End If
r = r + n - 1
Next r
On Error Resume Next
.Range("A3:A" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End With
Application.ScreenUpdating = True End Sub