Sub SUMDAT()
Dim i&, r&
Set d = CreateObject("Scripting.Dictionary")
r = Cells(Rows.Count, 1).End(3).Row
arr = Range("a2:b" & r)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
Next
y = d.keys
t = d.items
[d2].Resize(UBound(y) + 1, 1) = Application.Transpose(y)
[e2].Resize(UBound(t) + 1, 1) = Application.Transpose(t)
End Sub