Expanding table via Scripting dictionary

[Michael M]

Hi All
I've been trying to improve my knowledge of Dictionaries and have been using this code kindly submitted by @Rick Rothstein some time ago.
How can I expand the data so that it also sums column "C" as well. Any help would be much appreciated

Sub Consolidate()
  Dim R As Long, Data As Variant
  Data = Range("A2", Cells(Rows.Count, "B").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      .Item(Data(R, 1)) = .Item(Data(R, 1)) + Data(R, 2)
     Next R
    Range("D2").Resize(.Count) = Application.Transpose(.Keys)
    Range("E2").Resize(.Count) = Application.Transpose(.Items)
  End With
End Sub

 

[JoeMo]

This modification should put the sum of column "C" in column "F".

Sub Consolidate2()
  Dim R As Long, Data As Variant
  Data = Range("A2", Cells(Rows.Count, "C").End(xlUp))
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      .Item(Data(R, 1)) = .Item(Data(R, 1)) + Data(R, 2)
     Next R
    Range("D2").Resize(.Count) = Application.Transpose(.Keys)
    Range("E2").Resize(.Count) = Application.Transpose(.Items)
    .RemoveAll
    For R = 1 To UBound(Data)
      .Item(Data(R, 1)) = .Item(Data(R, 1)) + Data(R, 3)
     Next R
    Range("F2").Resize(.Count) = Application.Transpose(.Items)
  End With
End Sub

 

[Michael M]

@JoeMo Ahh, now I get it....it needed another loop, where I was trying inert an extra line in the first loop.
Much appreciated Joe...?

 

[Fluff]

Another option without an extra loop

Sub Consolidate()
   Dim R As Long, Data As Variant, Tmp As Variant
   Data = Range("A2", Cells(Rows.Count, "C").End(xlUp))
   With CreateObject("Scripting.Dictionary")
      For R = 1 To UBound(Data)
         If Not .Exists(Data(R, 1)) Then
            .Add Data(R, 1), Array(Data(R, 2), Data(R, 3))
         Else
            Tmp = .Item(Data(R, 1))
            Tmp(0) = Tmp(0) + Data(R, 2)
            Tmp(1) = Tmp(1) + Data(R, 3)
            .Item(Data(R, 1)) = Tmp
         End If
      Next R
      Range("D2").Resize(.Count) = Application.Transpose(.Keys)
      Range("E2").Resize(.Count, 2) = Application.Index(.Items, 0, 0)
   End With
End Sub

 

[Peter_SSs]

You could also process the additions in the array method directly without the Tmp array.
This and Fluff's code assume the default Option Base of 0

Sub Consolidate3()
   Dim R As Long, Data As Variant
   Data = Range("A2", Cells(Rows.Count, "C").End(xlUp))
   With CreateObject("Scripting.Dictionary")
      For R = 1 To UBound(Data)
         If Not .Exists(Data(R, 1)) Then
            .Add Data(R, 1), Array(Data(R, 2), Data(R, 3))
         Else
            .Item(Data(R, 1)) = Array(.Item(Data(R, 1))(0) + Data(R, 2), .Item(Data(R, 1))(1) + Data(R, 3))
         End If
      Next R
      Range("D2").Resize(.Count) = Application.Transpose(.keys)
      Range("E2").Resize(.Count, 2) = Application.Index(.Items, 0, 0)
   End With
End Sub

 

[Michael M]

Thanks to @Peter_SSs , @Fluff and @JoeMo
As always more thasn one way to process data!!
Am I safe to assume that the code by Peter would be slightly quicker than that of Fluff and Joe??
I guess I can't mark ALL as a solution, as they all a re correct, but slightly different.....I'll let the Mods decide which should be considered the best solution

 

[DanteAmor]

We could add the first item with (0,0) and then add the values, just to simplify the Else.

Sub Consolidate4()
  Dim R As Long, Data As Variant, dic As Object
  Data = Range("A2", Cells(Rows.Count, "C").End(xlUp))
  Set dic = CreateObject("Scripting.Dictionary")
  For R = 1 To UBound(Data)
    If Not dic.exists(Data(R, 1)) Then dic(Data(R, 1)) = Array(0, 0)
    dic(Data(R, 1)) = Array(dic(Data(R, 1))(0) + Data(R, 2), dic(Data(R, 1))(1) + Data(R, 3))
  Next
  Range("D2").Resize(dic.Count) = Application.Transpose(dic.Keys)
  Range("E2").Resize(dic.Count, 2) = Application.Index(dic.Items, 0, 0)
End Sub

 

[Michael M]

@DanteAmor
Very nice Dante, I appreciate your input as always....Thank you.. ? ?

 

[Michael M]

So I ran the code over 30000 rows and timed them.
I don't know why but the first code supplied by @JoeMo came up the fastest. Any explanation for that, apart from the bleeding obvious ( it was faster!!)

Scripting Dictionary Example multi.xls
	I	J	K	L
2	DanteAmor	=	0.34765625	seconds
3	Peter_SSs	=	0.421875	seconds
4	Fluff	=	0.3125	seconds
5	JoeMo	=	0.2890265	seconds
Sum Data

 

[DanteAmor]

It's definitely adding a condition, programs are slower when you add conditions. The JoeMo code has no condition.