vba help - Dictionary multiple Column Sum for same key

[Mallesh23]

Hi Team,

how to make multiple columns sum using dictionary.

Input Colums A,B and C are input Columns,
Expected Output Columns - G,H,I.

Below is input data with expected ouput in ghi columns

Book2
	A	B	C	D	E	F	G	H	I
1	Name	Century	Fifty	Double Century		Name	Total Century	Total Fifty	Double Century
2	Sachin	10	40	2		Sachin	30	51	5
3	Dhoni	20	25	1		Dhoni	20	25	1
4	Sachin	20	11	3		Kohli	30	25	4
5	Kohli	30	25	4
Sheet1

My Attempted Code, which works for extracting Single Columns
how to make dynamic code, so that It can store multiple columns, in dictionary Items with sum value.

Sub SumUsing_Dictionary()

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim cl As Range
Dim total As Long

Dim k As String
dict.RemoveAll

With dict
    For i = 2 To 5
            k = Cells(i, 1).Value  'Key
            total = Cells(i, 2).Value ' Total
    
        If Not .Exists(k) Then
                .Add k, total
            Else
                .Item(k) = .Item(k) + total
        End If
    Next i

End With



For Each cl In Range("F2", Range("F" & Rows.Count).End(xlUp))
         If dict.Exists(cl.Value) Then
                cl.Offset(, 1).Value = dict.Item(cl.Value)
          End If
Next cl


End Sub


Sub SumUsing_Dictionary_2()

Dim dict As New Scripting.Dictionary
Dim i As Long
Dim cl As Range
Dim total As Long


dict.RemoveAll
With dict
For Each cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         .Item(cl.Value) = .Item(cl.Value) + cl.Offset(, 1).Value
    Next cl
End With

For Each cl In Range("G2", Range("G" & Rows.Count).End(xlUp))
         If dict.Exists(cl.Value) Then
                cl.Offset(, 1).Value = dict.Item(cl.Value)
          End If
Next cl

End Sub

Thanks
mg

 

[Fluff]

How about

Sub Mallesh()
   Dim Cl As Range
   Dim Tmp As Variant
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .Exists(Cl.Value) Then
            .Add Cl.Value, Array(Cl.Offset(, 1).Value, Cl.Offset(, 2).Value, Cl.Offset(, 3).Value)
         Else
            Tmp = .Item(Cl.Value)
            Tmp(0) = Tmp(0) + Cl.Offset(, 1).Value
            Tmp(1) = Tmp(1) + Cl.Offset(, 2).Value
            Tmp(2) = Tmp(2) + Cl.Offset(, 3).Value
            .Item(Cl.Value) = Tmp
         End If
      Next Cl
      For Each Cl In Range("F2", Range("F" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then Cl.Offset(, 1).Resize(, 3).Value = .Item(Cl.Value)
      Next Cl
   End With
End Sub

 

[Mallesh23]

Hi Fluff,

Perfect !!!! it worked supert. millions of thanks for your help. ?



Thanks
mg

 

[Fluff]

Glad to help & thanks for the feedback.