Here is one approach:
Sub x()
Dim vNames(), vInput(), i As Long, n As Long
vInput = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
ReDim vNames(1 To UBound(vInput, 1), 1 To 2)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(vInput, 1)
If Not .Exists(vInput(i, 1)) Then
n = n + 1
vNames(n, 1) = vInput(i, 1)
vNames(n, 2) = vInput(i, 2)
.Add vInput(i, 1), n
ElseIf .Exists(vInput(i, 1)) Then
vNames(.Item(vInput(i, 1)), 2) = vNames(.Item(vInput(i, 1)), 2) + vInput(i, 2)
End If
Next i
End With
Range("G1").Resize(n, 2) = vNames
End Sub
Bookmarks