CODEWITHSUNDEEP
vbaexceldictionary
CodinglyClueless
CodinglyClueless

Reputation: 82

VBA Dictionary is Duplicating Keys

having trouble and need some help. I have created a simple example to learn dictionaries in VBA and have already run into an issue. I have the following set up:

enter image description here

I am trying to loop over the keys, adding in the key and item. If the key exists, I want to add the item to it. What is happening instead is that the Key's get duplicated. In the example below, I end up with 2 keys for Apples instead of 1. What am I doing wrong? Any help is greatly appreciated. Relevant code below:

Dim wkb As Workbook
Dim ws As Worksheet
Dim dict As Scripting.Dictionary

Set wkb = ActiveWorkbook
Set ws = wkb.ActiveSheet

'clearing old totals
ws.Range("C8:C9").ClearContents

Set dict = New Scripting.Dictionary
dict.CompareMode = vbTextCompare

For i = 3 To 6
    If dict.Exists(ws.Cells(i, "B").Value) = False Then
        MsgBox "doesnt exist, adding " & ws.Cells(i, "B")
        dict.Add ws.Cells(i, "B"), ws.Cells(i, "C")
    ElseIf dict.Exists(ws.Cells(i, "B").Value) Then
        MsgBox "exists"
        dict.Item(ws.Cells(i, "B")) = dict.Item(ws.Cells(i, "B")) + ws.Cells(i, "C").Value
    End If
Next i

MyArray = dict.Keys
MsgBox "Keys are: " & Join(MyArray, ";")

MyArray = dict.Items
MsgBox "Items are: " & Join(MyArray, ";")

For Each k In dict.Keys
    ws.Range("C8") = ws.Range("C8") + dict.Item(k)
    If k = "Apples" Then
        ws.Range("C9") = ws.Range("C9") + dict.Item(k)
    End If
Next

Upvotes: 2

Views: 5087

Answers (1)

YowE3K
YowE3K

Reputation: 23974

You are currently adding the cell as the key, rather than the Value of the cell, and cell B6 is not cell B3 - they have different .Row properties at least.

You should change your code to:

For i = 3 To 6
    If dict.Exists(ws.Cells(i, "B").Value) = False Then
        MsgBox "doesnt exist, adding " & ws.Cells(i, "B").Value
        dict.Add ws.Cells(i, "B").Value, ws.Cells(i, "C").Value
    ElseIf dict.Exists(ws.Cells(i, "B").Value) Then
        MsgBox "exists"
        dict.Item(ws.Cells(i, "B").Value) = dict.Item(ws.Cells(i, "B").Value) + ws.Cells(i, "C").Value
    End If
Next i

Upvotes: 8

Related Questions