Error when I Call Show function. Creates an extra element in Dictionary

[jcarneir]

Hi,

I created 2 Classes. An Internal_Dict with items of type "double" and an external Dict with items of type Internal_Dict. Both classes have a Show procedure to print the data. I created a test procedure to verifies both classes. Internal_Dict it's Ok but External_Dict has an issue: when the trace enter the show function the count increases by one. It creates a new item with an empty key. That generates an error when try to print that new item.

Class Module IntDict
'private Attributes
Private pInternalDict As Scripting.Dictionary

'Class Initialize/Terminate methods
Private Sub Class_Initialize()
Set pInternalDict = New Scripting.Dictionary
End Sub

Private Sub Class_Terminate()
Set pInternalDict = Nothing
End Sub

'Add/Count/Items/Item/Remove/Remove All Methods
Public Function Add(Key As Variant, Item As Double)
pInternalDict.Add Key:=Key, Item:=Item
End Function

Public Function Update(Key As Variant, Item As Double)
If pInternalDict.Exists(Key) Then
pInternalDict.Item(Key) = pInternalDict.Item(Key) + Item
Else
pInternalDict.Add Key:=Key, Item:=Item
End If
End Function

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

Public Property Get Items() As Scripting.Dictionary
Set Items = pInternalDict
End Property

Public Property Get Item(vItem As Variant) As Double
Item = pInternalDict.Item(vItem)
End Property

Public Function Exists(vItem As Variant) As Boolean
Exists = pRentas.Exists(vItem)
End Function

Public Sub Show()
Dim vKey As Variant

For Each vKey In pInternalDict.Keys
Debug.Print vKey & "|" & pInternalDict.Item(vKey)
Next
End Sub

Class Module ExtDict
'private Attributes
Private pExternalDict As Scripting.Dictionary

'Class Initialize/Terminate methods
Private Sub Class_Initialize()
Set pExternalDict = New Scripting.Dictionary
End Sub

Private Sub Class_Terminate()
Set pExternalDict = Nothing
End Sub

'Add/Count/Items/Item/Remove/Remove All Methods
Public Function Add(Key As Variant, Item As CInternalDict)
pExternalDict.Add Key:=Key, Item:=Item
End Function

Public Function Update(ExternalKey As Variant, InternalKey As Variant, Item As Double)
Dim newIntDict As CInternalDict

If pExternalDict.Exists(ExternalKey) Then
With pExternalDict.Item(ExternalKey)
Call .Update(InternalKey, Item)
End With
Else
Set newIntDict = New CInternalDict
newIntDict.Add Key:=InternalKey, Item:=Item
pExternalDict.Add Key:=ExternalKey, Item:=newIntDict
End If
End Function

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

Public Property Get Items() As Scripting.Dictionary
Set Items = pExternalDict
End Property

Public Property Get Item(vItem As Variant) As CRentasCasa
Item = pExternalDict.Item(vItem)
End Property

Public Function Exists(vItem As Variant) As Boolean
Exists = pExternalDict.Exists(vItem)
End Function

Public Sub Show()
Dim vKey As Variant
Dim dItem As CInternalDict

For Each vKey In pExternalDict.Keys
Debug.Print vKey 'Print external key
Set dItem = pExternalDict.Item(vKey)
dItem.Show 'Show Internal Dict
Next
End Sub

=========================
'Externals procedures

Sub Test_InternalDict() 'It's OK
Dim myIntDict As CInternalDict

Set myIntDict = New CInternalDict
myIntDict.Update "IntBox1", 1500
myIntDict.Update "IntBox2", 1800
myIntDict.Update "IntBox1", 200
myIntDict.Update "IntBox2", 100
myIntDict.Update "IntBox1", 100
myIntDict.Update "IntBox3", 1500
myIntDict.Update "IntBox4", 1900
myIntDict.Show
Set myIntDict = Nothing
End Sub

'Creates the ExternalDict in the right way but show call has a bad behavior
Sub Test_ExternalDict()
Dim myExtDict As CExternalDict

Set myExtDict = New CExternalDict
myExtDict.Update "ExtBox1", 6, 1500
myExtDict.Update "ExtBox1", 8, 1800
myExtDict.Update "ExtBox2", 5, 100
myExtDict.Update "ExtBox3", 7, 1900
myExtDict.Update "ExtBox1", 7, 1600
myExtDict.Update "ExtBox2", 8, 1900
myExtDict.Update "ExtBox3", 4, 100
myExtDict.Update "ExtBox1", 7, 300
myExtDict.Update "ExtBox2", 5, 1400
myExtDict.Update "ExtBox3", 4, 1500
myExtDict.Update "ExtBox1", 6, 200
myExtDict.Update "ExtBox3", 5, 200
myExtDict.Update "ExtBox3", 5, 1800
myExtDict.Update "ExtBox3", 7, -100
myExtDict.Show 'ERROR. Add an Item when enter in the Show Function
Set myExtDict = Nothing
End Sub


'Any clue????

 

[jcarneir]

Solved.

Solved. The code it's right!!!

Vba dictionary has an issue when accessing and item that not exists: vba creates an empty item with an empty key.

The code never evaluate a not existing element but in the watch window I have an expression that was viewing an external variable of dictionary type. When entering to the module show, the watching expression add an item.

I just cleaned the watching window.

 

[dilettante]

There is no "VBA Dictionary" and if you are using VBA you are posting in the wrong forum anyway.

This forum is for questions about VB6 and earlier.

As for the Scripting.Dictionary class you seem to be using... it has no "issue." This is documented behavior and it is working as intended. Your code is bad, that's all.