0

I have a series of data where each item has a number of values associated with it. Blocks of items will share these values, then for other items these will change.

I am transferring over the data between databases. In the old one each item has all of its values stored separately. In the new database I want to take advantage of the fact that large numbers of items share the same values by storing these sets of values as a configuration. I am doing this in vba for excel.

To identify what the unique sets of values are I wanted to use a dictionary where the key is a collection. I got lulled into a false sense of security by it allowing me to do this, however it doesnt manage to identify where keys are identical.

Example code as follows. Should add just two items to the dictionary but adds all 3. Am I missing something or just expecting too much of the dictionary? Would save me a little time if I didnt manually have to compare all the sets.

Sub CollectionAsKeyTest()
Dim dic As New Dictionary
Dim col As Collection
Dim i As Integer

dic.CompareMode = BinaryCompare

'Create a collection to add to dictionary:
Set col = New Collection
For i = 1 To 10
    col.Add i * 1
Next i
dic.Add col, "item 1"

'Create a different collection and add as key to dictionary:
Set col = New Collection
For i = 1 To 10
    col.Add i * 2
Next i
If Not dic.Exists(col) Then dic.Add col, "item 2"

'Create a collection which is the same as the first, and try to add to dictionary:
Set col = New Collection
For i = 1 To 10
    col.Add i * 1
Next i
If Not dic.Exists(col) Then dic.Add col, "item 3"

'All three collections are added:
Debug.Print "Number of collections added = " & dic.count
End Sub
7
  • Each time col is a new collection so it won't exist in your dictionary. Commented Mar 20, 2019 at 10:04
  • Its a new collection each time, but contains the same data.. Doesnt that make it the same? Commented Mar 20, 2019 at 10:09
  • 1
    Why are you storing the collection as the Key? Store your collection as the Value and your Value as the Key Commented Mar 20, 2019 at 10:13
  • Objects are equal when they are identical. For example, Range("A1") isn't the same as Range("A2") even if Range("A1").Value = Range("A2").Value. Collections are objects. Commented Mar 20, 2019 at 10:17
  • 2
    @SJR I think so, though you could experiment. Personally, I never use a VBA dictionary with keys that are neither strings nor numbers, precisely because the semantics are a bit unintuitive. I am not 100% sure how a collection is hashed to get a key. This question discusses it. Commented Mar 20, 2019 at 10:34

1 Answer 1

3

As discussed in the comments, two objects (eg two Collections or two Ranges) are not identically, even when they have the same value(s), and your dic.Exists(col) will always fail.

I would suggest to put the collections as Value and to write a kind of hash as key. If the collections does not contain too much data, simply concatenate all elements of the collection and put this as key, but if you want it a bit more sophisticated, you can calculate a real hash first.

The following code gives you an idea. The hashing routine is copied from https://en.wikibooks.org/wiki/Visual_Basic_for_Applications/String_Hashing_in_VBA

...
dim hash as string
hash = getHash(col)
If Not dic.Exists(hash) Then dic.Add hash, col
...

Function getHash(c As Collection)

    Dim s As String, i As Long
    For i = 1 To c.Count
        s = s & c(i) & "@@@"
    Next i
    ' Simple: 
    '   getHash = s
    ' Use a real hash:
    getHash = MD5(s)

End Function

Function MD5(ByVal sIn As String) As String

    Dim oT As Object, oMD5 As Object
    Dim TextToHash() As Byte
    Dim bytes() As Byte

    Set oT = CreateObject("System.Text.UTF8Encoding")
    Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

    TextToHash = oT.GetBytes_4(sIn)
    bytes = oMD5.ComputeHash_2((TextToHash))

    MD5 = ConvToHexString(bytes)

    Set oT = Nothing
    Set oMD5 = Nothing

End Function


Private Function ConvToHexString(vIn As Variant) As Variant

    Dim oD As Object

    Set oD = CreateObject("MSXML2.DOMDocument")

      With oD
        .LoadXML "<root />"
        .DocumentElement.DataType = "bin.Hex"
        .DocumentElement.nodeTypedValue = vIn
      End With
    ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, "")

    Set oD = Nothing

End Function
Sign up to request clarification or add additional context in comments.

1 Comment

Great answer. Thank you!

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.