VBA - Overpass default Scripting.Dictionary Keys comparison

[saboh12617]

Hello,

I am currently working on a set of two classes: one being a custom object model, and the latter a custom Dictionary class, with my 1st class as key, and the items being arraylists.

I am facing a problem for which i am completely aware and kinda anticipated. It is explained here in details excel - Acces an item in a dictionary with a custom object key in vba - Stack Overflow

But basically when i want to check my keys list to retrieve a "new" item, i can not find it because it has a different pointer from the original one added in the list, even if all of their properties are equal.

I created in my class a custom .Equals function, to handle this problem manually. But i dont know how i can "force" my custom dictionary to use this function instead of simply looking the addresses of the objects in the memory. Is it even possible?


I guess i will have to loop on all the keys and apply my Equals function on all of them, to retrieve the "original object", and use it. But doing so, where should this code be applied? In the MyDictionnary.Keys functions?

I can post some code if it helps, but the problem is more about how to overpass the default Key search on a custom dictionary.

 

[RoryA]

It will depend on how you implemented your custom dictionary's Item method, I would think.

 

[saboh12617]

Hi Rory, thanks for your quick answer.

As it is my first time creating a custom dictionnary class, i am struggling quite a bit since i find very few information about it.

I did not implement a .Item method yet, i understand how it is important to retrive my arraylist indeed, but the problem remains the same. Since my class is basically a wrapper around a "vanilla" dictionary (as i saw it is how it should be done), i can not retrieve the key in this dictionary since it is a custom class instance, and VBA makes no call to my .Equals method by default.


Below my WIP dictionary class, with the error raised in .Add method:
(for context i am trying to represent a tree structure, hence the parent/children mixture)

Option Explicit
' REQUIRES REFERENCE TO Micorsoft Scripting Runtime + mscorlib
Private nodesDict As Scripting.Dictionary

Private Sub Class_Initialize()
    Set nodesDict = New Scripting.Dictionary
End Sub
 
Private Sub Class_Terminate()
    Set nodesDict = Nothing
End Sub

Public Property Get Count() As Long
  Count = nodesDict.Count
End Property

Public Property Get Exists(nodo As Node) As Boolean
  Exists = False

  Dim key As Variant
  For Each key In nodesDict.Keys
    If key.Equals(nodo) Then
      Exists = True
      Exit Sub
    End If
  Next key
End Sub

Public Sub Remove(nodo As Node)
  Dim key As Variant
  For Each key In nodesDict.Keys
    If key.Equals(nodo) Then
      nodesDict.Remove key
      Exit Sub
    End If
  Next key
End Sub

Public Property Get Nodes() As ArrayList
  Dim keyArr As New ArrayList
  Dim key As Variant
  For Each key In nodesDict.Keys
    keyArr.Add key
  Next key

  Set Nodes = keyArr
End Property

Public Sub AddFromStr(str As String)
  Dim nodeTree As Variant
  nodeTree = VBA.Split(str, ".")
 
  Dim nodeIni As Node
  Set nodeIni = New Node
  nodeIni.rank = 0
  nodeIni.number = CLng(nodeTree(0))
  Me.Add nodeIni

  If UBound(nodeTree) < 1 Then Exit Sub

  Dim i As Long, currNode As Node, prevNode As Node
  Set prevNode = nodeIni
  For i = 1 To UBound(nodeTree)
    Set currNode = New Node
    currNode.rank = i
    currNode.number = CLng(nodeTree(i))
    Set currNode.parent = prevNode.Copy
    Me.Add currNode
    ' pointer issue here ? To check
    Set prevNode = currNode
  Next i

End Sub

Public Sub Add(nodo As Node, Optional children As ArrayList)
 
  ' if the current node is not the root node, add the current
  ' node to its parent children list
  If Not nodo.parent Is Nothing Then
    ' check if the parent node is already in the list, otherwise add it
    If Me.Exists(nodo.parent) Then
    
      ' --------------------------------------
      ' here below i have my issue
      ' --------------------------------------
      nodesDict.Keys(nodo.parent).Add nodo
    Else
      Me.Add nodo.parent
    End If
  End If

  If children Is Nothing Then Set children = New ArrayList

  If Not Me.Exists(nodo) Then
    nodesDict.Add key:=nodo, Item:=children
  End If
End Sub

 

[RoryA]

You don't appear to have an Equals method at all, and you can't simply expect it to magically be added to the Variant items in the default Keys.

You will need to implement an Item method in your class that will need to check the type of the value passed to it and respond as needed. If it's one of your custom objects, then the code is going to need to loop through all its properties and see if it's the same.

 

[saboh12617]

Thank you very much for your expertise Rory, it was exactly the problem!

I had mixed up my keys and items, hence my problem and my misunderstanding. I corrected it and the problem is fixed!
And yes, the .Equals method is in the Node class, that i did not post. It is just checking a bunch of properties nothing special.

So for those wondering, I added the .Item method like this

Public Property Get Item(keyNode As Node) As ArrayList
  Dim key As Node, i As Long

  For i = 0 To Me.Count - 1
    Set key = nodesDict.Keys(i)
    If keyNode.Equals(key) Then
      Set Item = nodesDict.Item(key)
      Exit Property
    End If
  Next i
End Property

And corrected my wrong call from

nodesDict.Keys(nodo.parent).Add nodo

to

Me.Item(nodo.parent).Add nodo

Have a good weekend