Duplicate Row Sum - excel

Question

I'm attempting to combine duplicated rows in a table while summing the numbers in the last column, then creating a new summarized table below.
Only the first duplicated row is being summed. This value then appears in all of the rows below.
Example Table - five Columns
Sub CombineDupesV3()
Dim x As Long
Dim r As Long
Dim arr() As Variant
Dim dic As Object
Const DELIM As String = "|"
Set dic = CreateObject("Scripting.Dictionary")
x = Cells(Rows.Count, 1).End(xlUp).Row
arr = Cells(1, 1).Resize(x, 5).Value
For x = LBound(arr, 1) + 1 To UBound(arr, 1)
If dic.exists(arr(x, 1)) Then
arr(x, 5) = arr(x, 5) + CDbl(Split(dic(arr(x, 1)), DELIM)(3))
Else
dic(arr(x, 1)) = arr(x, 2) & DELIM & arr(x, 3) & DELIM & arr(x, 4) & DELIM & arr(x, 5)
End If
dic(arr(x, 1)) = arr(x, 2) & DELIM & arr(x, 3) & DELIM & arr(x, 4) & DELIM & arr(x, 5)
Debug.Print "X = " & x
Next x
r = UBound(arr, 1) + 2
Application.ScreenUpdating = False
Cells(r, 1).Resize(, 5).Value = Cells(1, 1).Resize(, 5).Value
r = r + 1
For x = 0 To dic.Count - 1
Cells(r + x, 1).Value = dic.keys()(x)
Cells(r + x, 2).Resize(, 4).Value = Split(dic.items()(x), DELIM)
Cells(r + x, 5).Value = CDbl(Cells(r, 5).Value)
Debug.Print "R = " & r
Next x
Application.ScreenUpdating = True
Erase arr
Set dic = Nothing
End Sub

Answer 1

The conversion line in the last loop should address the correct row value r + x
For x = 0 To dic.Count - 1
Cells(r + x, 1).Value = dic.keys()(x)
Cells(r + x, 2).Resize(, 4).Value = Split(dic.items()(x), DELIM)
'>> convert string to double <<
Cells(r + x, 5).Value = CDbl(Cells(r + x, 5).Value)
Next x
Further hints:
Try to fully qualify all range references in order to avoid unwanted results as unqualified cell addresses refer to the active sheet by default which needn't be the one you have in mind :-)
You should either redefine the data range definition or the target range as they might conflict if you run code twice.