Question : Scripting Dictionary

Hi Experts,

I'm feeling totally dumb about this as I cannot get the macro below to work - it's in the attached file.

All I want to do is create a unique list of items in a dictionary and output it to a worksheet. It can't be much easier. I can do it with a collection without even thinking about it but...

I have even used the Scripting Dictionary successfully in several questions but this time in my trial file, I dunno, a haze has settled over me.

Patrick

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:



Sub dict_test()
Dim rng As Range
Dim celle As Range
Dim dic_item
Dim i As Long

Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
dic.CompareMode = TextCompare

With Sheets("Sheet1")
    Set rng = Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))

    For Each celle In rng
        If Not dic.exists(celle) Then
            dic.Add celle, celle
        End If
    Next celle
    
    For i = 1 To dic.Count
        .Cells(i, "C") = dic.Item(i)
    Next i
End With

End Sub

Attachments:

Dict-test-01.xls (30 KB) (File Type Details)

xls

Answer : Scripting Dictionary

Patrick,

A few things, which are addressed in my article http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html

1) Unlike a Collection, you cannot refer to items in a dictionary using an index. Rather, in a dictionary, you can only fetch a single item if you supply its key. So, your loop:

For i = 1 To dic.Count
.Cells(i, "C") = dic.Item(i)
Next i

will not pull out items from the dictionary. Indeed, because of the dictionary's "implicit add" behavior, that loop is actually adding new items to the dictionary :)

2) You were actually adding the range as the key, and not the value of the cell, in your first loop:

For Each celle In rng
If Not dic.exists(celle) Then
dic.Add celle, celle
End If
Next celle

Since each cell is a different object, you actually ended up adding all of those cells as both item and key

******************

So, to fix the code:

1) Explicitly pass the values of the cells, and not the cells themselves, to the dictionary. Or, use an array transfer to create an array in memory, and then loop through the array and pass array values to the dictionary

2) Dump the items into an array

3) Do an array transfer to write the values to the worksheet

Patrick

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:



Sub dict_test()
    
    Dim rng As Range
    Dim celle As Range
    Dim dic_items As Variant
    Dim i As Long
    Dim x As Variant
    
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary
    dic.CompareMode = 1
    
    With Sheets("Sheet1")
        Set rng = Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    
        For Each celle In rng
            If Not dic.exists(celle.Value) Then
                dic.Add celle.Value, celle.Value
            End If
        Next celle
        
        dic_items = dic.Items
        
        .[c:c].ClearContents
        .[c1].Resize(dic.Count, 1) = Application.Transpose(dic_items)
    End With
    
    Set dic = Nothing
    
End Sub