VBA: Find duplicates in column a, add sums of b and c - excel

Question

Pretty new to all this and just giving it all a go. Just building a pet project in excel and it's coming along nicely(i'm actually midly in love with it and enjoying myself far to much!)...until i hit this wall and i'm totally stumped.
Anyway, I've hit a wall and have been search for ages to get an answer.
I'm trying to configure a vba to find duplicaates in column a(so say items). When it finds a duplicate i want it to take column b and add the sum and take column c and add the sums. All duplicates get deleted and it gets replaced/new sheet with it nice and neat. I'm tried like 100 different things, search and search and got nowhere.
This is what I want to achieve:
I'm looking at something like but it only works on summing the b column.
Dim Cl As Range
Dim Cnt As Long
With CreateObject("scripting.dictionary")
For Each Cl In Range("a1", Range("a" & Rows.Count).End(xlUp))
If Not .exists(Cl.Value) Then
.Add Cl.Value, Cl.Offset(, 1).Value
Else
.Item(Cl.Value) = .Item(Cl.Value) + Cl.Offset(, 1).Value
End If
Next Cl
Sheets("test").Range("A1").Resize(.Count).Value = Application.Transpose(.Keys)
Sheets("test").Range("B1").Resize(.Count).Value = Application.Transpose(.items)
End With
But it only works for the first column. I can't work out how to do it with the second range. Any help would be greatly appreciated.

Answer 1

Try this code, please:
Sub DuplicatesSum2Columns()
Dim cl As Range, arr, arrFin, El, k As Long
With CreateObject("scripting.dictionary")
For Each cl In Range("a1", Range("a" & Rows.count).End(xlUp))
If Not .Exists(cl.value) Then
.Add cl.value, cl.Offset(, 1).value & "|" & cl.Offset(, 2).value
Else
arr = Split(.item(cl.value), "|") 'split the dictionary item to load the two columns
.item(cl.value) = arr(0) + cl.Offset(, 1).value & "|" & arr(1) + cl.Offset(, 2).value
End If
Next cl
ReDim arrFin(1 To .count, 1 To 3): k = 1
'Put the dictionary keys and split items in the final array:
For Each El In .Keys
arrFin(k, 1) = El
arrFin(k, 2) = CLng(Split(.item(El), "|")(0))
arrFin(k, 3) = CLng(Split(.item(El), "|")(1))
k = k + 1
Next
'drop the array values at once:
Sheets("test").Range("A1").Resize(UBound(arrFin), UBound(arrFin, 2)).value = arrFin
End With
End Sub

Answer 2

You could do this without VBA in O365.
E1 =UNIQUE(A1:A16)
F1 =SUMIFS(B$1:B$16,$A$1:$A$16,$E1#)
G1 =SUMIFS(B$1:B$16,$A$1:$A$16,$E1#)

Answer 3

Slightly misread the question, thought you wanted to sum both columns together nor separately.
Sub SumDups()
Dim dic As Object
Dim rng As Range
Dim arrDataIn() As Variant
Dim arrDataOut() As Variant
Dim arrSums() As Variant
Dim idxRow As Long
Dim ky As Variant
Set rng = Sheets("Sheet1").Range("A1").CurrentRegion
arrDataIn = rng.Value
Set dic = CreateObject("Scripting.Dictionary")
For idxRow = LBound(arrDataIn, 1) To UBound(arrDataIn, 1)
ky = arrDataIn(idxRow, 1)
If dic.Exists(ky) Then
arrSums = dic(ky)
Else
arrSums = Array(0, 0)
End If
arrSums = Array(arrSums(0) + arrDataIn(idxRow, 2), arrSums(1) + arrDataIn(idxRow, 3))
dic(ky) = arrSums
Next idxRow
ReDim arrDataOut(1 To dic.Count, 1 To 3)
idxRow = 1
For Each ky In dic.Keys
arrSums = dic(ky)
arrDataOut(idxRow, 1) = ky
arrDataOut(idxRow, 2) = arrSums(0)
arrDataOut(idxRow, 3) = arrSums(1)
idxRow = idxRow + 1
Next ky
Range("E1").Resize(dic.Count, 3).Value = arrDataOut
End Sub