Dictionary in VBA

[chriscorpion786]

Hi,

I'm using the dictionary in VBA to summarize based on the units held in one column, but I would also like the code to summarize by amount, which is in another column, can I do this in the same sub and output both the results by name for units and amount. I have pasted the example how the output should be like below.

Dim dict As Dictionary
Set dict = New Dictionary


Dim name As String
Dim amount As Double
Dim units As Long
Dim r As Range
Dim key As Variant




Set r = Range("A1").CurrentRegion


For i = 2 To r.Rows.Count


name = r.Cells(i, 1).Value
units = r.Cells(i, 4).Value
amount = r.cells(i,5).value


dict(name) = dict(name) + units
dict(name) = dict(name) + amount


Next i

x = 2


For Each key In dict


Cells(x, 8).Value = key
Cells(x, 9).Value = dict(key)


x = x + 1


Next key
End Sub



Example.....
[TABLE="width: 292"]
<colgroup><col><col span="2"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Unit[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD] Jonathan [/TD]
[TD] 215,544[/TD]
[TD] 657,015[/TD]
[/TR]
[TR]
[TD] Mustafa [/TD]
[TD] 263,448[/TD]
[TD] 1,208,102[/TD]
[/TR]
[TR]
[TD] Mahmood [/TD]
[TD] 217,368[/TD]
[TD] 662,254[/TD]
[/TR]
[TR]
[TD] Daniel [/TD]
[TD] 198,912[/TD]
[TD] 606,677[/TD]
[/TR]
[TR]
[TD] Sam Benjamin [/TD]
[TD] 202,560[/TD]
[TD] 617,457[/TD]
[/TR]
[TR]
[TD] Mike Hallet [/TD]
[TD] 226,800[/TD]
[TD] 691,292[/TD]
[/TR]
[TR]
[TD] Harry Stanley [/TD]
[TD] 207,696[/TD]
[TD] 632,754[/TD]
[/TR]
[TR]
[TD] Christopher [/TD]
[TD] 220,152[/TD]
[TD] 671,133[/TD]
[/TR]
[TR]
[TD] Tasawar [/TD]
[TD] 195,960[/TD]
[TD] 597,515[/TD]
[/TR]
</tbody>[/TABLE]

 

[StephenCrump]

There are other ways you could do this, but to use a dictionary approach you could modify your code:

'....
Dim Amounts() As Long
Const N = 3     'You only need 2!
ReDim Amounts(1 To N) As Long

Set dict = New Dictionary
Set r = Range("A1").CurrentRegion

For i = 2 To r.Rows.Count
    name = r.Cells(i, 1).Value
    For j = 1 To N
        Amounts(j) = r.Cells(i, j + 1).Value
        On Error Resume Next
        Amounts(j) = Amounts(j) + dict(name)(j)
        On Error GoTo 0
    Next j
    dict(name) = Amounts
Next i

x = 2
For Each key In dict
    Cells(x, 8).Value = key
    For j = 1 To N
        Cells(x, 8 + j).Value = dict(key)(j)
    Next j
    x = x + 1
Next key

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	Name	Unit	Amount	Something				Results
2	Jonathan	215,544	657,015	1				Jonathan	418,104	1,274,472	6
3	Mustafa	263,448	1,208,102	2				Mustafa	490,248	1,899,394	8
4	Mahmood	217,368	662,254	3				Mahmood	425,064	1,295,008	10
5	Daniel	198,912	606,677	4				Daniel	394,872	1,204,192	13
6	Jonathan	202,560	617,457	5				Christopher	220,152	671,133	8
7	Mustafa	226,800	691,292	6
8	Mahmood	207,696	632,754	7
9	Christopher	220,152	671,133	8
10	Daniel	195,960	597,515	9
Sheet1

 

[wideboydixon]

Simplest method is to use two dictionaries I'd say:

Public Sub SummarizeData()

Dim dictUnits As Dictionary
Set dictUnits = New Dictionary
Dim dictAmount As Dictionary
Set dictAmount = New Dictionary

Dim name As String
Dim amount As Double
Dim units As Long
Dim r As Range
Dim key As Variant
Dim i As Long
Dim x As Long

Set r = Range("A1").CurrentRegion

For i = 2 To r.Rows.Count
    name = r.Cells(i, 1).Value
    units = r.Cells(i, 4).Value
    amount = r.Cells(i, 5).Value
    
    dictUnits(name) = dictUnits(name) + units
    dictAmount(name) = dictAmount(name) + amount
Next i

x = 2

For Each key In dictUnits
    Cells(x, 8).Value = key
    Cells(x, 9).Value = dictUnits(key)
    Cells(x, 10).Value = dictAmount(key)
    x = x + 1
Next key

End Sub

Please remember to use code tags when posting code.

WBD

 

[chriscorpion786]

Simplest method is to use two dictionaries I'd say:

Public Sub SummarizeData()

Dim dictUnits As Dictionary
Set dictUnits = New Dictionary
Dim dictAmount As Dictionary
Set dictAmount = New Dictionary

Dim name As String
Dim amount As Double
Dim units As Long
Dim r As Range
Dim key As Variant
Dim i As Long
Dim x As Long

Set r = Range("A1").CurrentRegion

For i = 2 To r.Rows.Count
    name = r.Cells(i, 1).Value
    units = r.Cells(i, 4).Value
    amount = r.Cells(i, 5).Value
    
    dictUnits(name) = dictUnits(name) + units
    dictAmount(name) = dictAmount(name) + amount
Next i

x = 2

For Each key In dictUnits
    Cells(x, 8).Value = key
    Cells(x, 9).Value = dictUnits(key)
    Cells(x, 10).Value = dictAmount(key)
    x = x + 1
Next key

End Sub

Please remember to use code tags when posting code.

WBD

Thank you, this code is so simple and worked perfect

 

[chriscorpion786]

Thank you, this code worked perfectly!!