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.....

Name	Unit	Amount
Jonathan	215,544	657,015
Mustafa	263,448	1,208,102
Mahmood	217,368	662,254
Daniel	198,912	606,677
Sam Benjamin	202,560	617,457
Mike Hallet	226,800	691,292
Harry Stanley	207,696	632,754
Christopher	220,152	671,133
Tasawar	195,960	597,515

<colgroup><col><col span="2"></colgroup><tbody>
</tbody>

 

[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!!