INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

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

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

(OP)
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????

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

(OP)
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.

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

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.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close