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.)

Ref1	#to sum	Ref2	#to sum	Ref3	#to sum	#to sum	Expected Action
1		A		10
1		A		20
1		A		30
3		B		10			All 3 columns match Row below so Merge/sum
3		B		10			All 3 columns match row above so Merge/sum with row above and delete row
3		B		20
5		A		10
5		A		20
5		A		30

<tbody>
</tbody>

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