VBA: Loop over Items in Dictionary with an Object Variable

Question

I am trying to loop over the items in a dictionary with an object variable that refer to inheritance class "Breed", but I am unable to do so with dictionaries but with collections it is pretty simple is there a way to solve this without using the dictionary's keys? because then I will lose the ability to use the intelisense feature.

Here is the code of the class Breed:

Option Explicit

Public Property Get Name() As String
End Property

Public Property Get Color() As String
End Property

Public Property Get Price() As Double
End Property

Here is the code for class Dogs:

Option Explicit

Implements Breed

Private pName As String, pPrice As Double, pColor As String

Public Property Let Name(Val As String)
    pName = Val
End Property

Public Property Get Name() As String
    Name = pName
End Property

Private Property Get Breed_Name() As String
    Breed_Name = Name
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Property Let Price(Val As Double)
    pPrice = Val
End Property

Public Property Get Price() As Double
    Price = pPrice
End Property

Private Property Get Breed_Price() As Double
    Breed_Price = Price
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Property Let Color(Val As String)
    pColor = Val
End Property

Public Property Get Color() As String
    Color = pColor
End Property

Private Property Get Breed_Color() As String
    Breed_Color = Color
End Property

Here is the code for class Cats:

Option Explicit

Implements Breed

Private pName As String, pPrice As Double, pColor As String

Public Property Let Name(Val As String)
    pName = Val
End Property

Public Property Get Name() As String
    Name = pName
End Property

Private Property Get Breed_Name() As String
    Breed_Name = Name
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Property Let Price(Val As Double)
    pPrice = Val
End Property

Public Property Get Price() As Double
    Price = pPrice
End Property

Private Property Get Breed_Price() As Double
    Breed_Price = Price
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Property Let Color(Val As String)
    pColor = Val
End Property

Public Property Get Color() As String
    Color = pColor
End Property

Private Property Get Breed_Color() As String
    Breed_Color = Color
End Property

Here is the code for the regular module with collection but fails with dictionary:

Option Explicit

Sub Main()

    Dim C           As Cats
    Dim D           As Dogs
    Dim Coll        As Collection
    Dim B           As Breed

    Set C = New Cats
    C.Name = "Catomon"
    C.Color = "Angle White"
    C.Price = 800.98

    Set D = New Dogs
    D.Name = "Dogomon"
    D.Color = "Golden White"
    D.Price = 1000.23

    Set Coll = New Collection
    Coll.Add C
    Coll.Add D

    Set B = New Breed

    For Each B In Coll
        Debug.Print B.Name, B.Color, B.Price
    Next B

    Set C = Nothing
    Set D = Nothing
    Set B = Nothing
    Set Coll = Nothing

End Sub

Answer 1

Dictionary methods .Keys() and .Items() return arrays. Only way to iterate over arrays is with an variable of type Variant. With these restrictions, the only way I can think of is casting Variant variable to the type Breed inside the loop. This way, after the casting, you get Intellisense.

Based on the code you posted, an example would be:

Sub MainWithDictionary()

    Dim C           As Cats
    Dim D           As Dogs
    Dim Dict        As Scripting.Dictionary
    Dim B           As Breed
    Dim K           As Variant 'new variable

    Set C = New Cats
    C.Name = "Catomon"
    C.Color = "Angle White"
    C.Price = 800.98

    Set D = New Dogs
    D.Name = "Dogomon"
    D.Color = "Golden White"
    D.Price = 1000.23

    Set Dict = New Scripting.Dictionary
    'Keys are just placeholders
    Dict.Add 1, C
    Dict.Add 2, D


    For Each K In Dict.Items()
        'Cast the Variant result to Breed
        Set B = K
        'You will have Intellisense on each dictionary items after this

        Debug.Print B.Name, B.Color, B.Price
    Next K

    Set C = Nothing
    Set D = Nothing
    Set B = Nothing
    Set Dict = Nothing

End Sub