Multiple instances of a single Property in a Class Object VBA

Question

Say I create a class called Farm. And it has 3 properties:

• FarmName as String
• NumberOfStables as Long
• HasHorse as Boolean

And I start the class

Dim SmithFarm as Farm
Set SmithFarm = New Farm
SmithFarm.FarmName = "Smith Farm"
SmithFarm.NumberOfStables = 3

Is there a way to create multiple copies of the HasHorse property? Say I want to know whether there's a horse in each of the Farm's Stables

Dim i As Long
For i = 1 To SmithFarm.NumberOfStables
    SmithFarm.HasHorse(i) = True
Next

So now SmithFarm would have Stable 1, Stable 2 and Stable 3 - all with horses that I can rent out and keep track of how many horses I have in the farm stables -

Dim currentHorses As Long
For i = 1 To SmithFarm.NumberOfStables
    If SmithFarm.HasHorse(i) Then currentHorses = currentHorses + 1
Next

Or maybe I want to see if the second stable has a horse-

Dim targetStable As Long
targetStable = 2
If Not SmithFarm.HasHorse(targetStable) Then MsgBox "There's no horse here!"

How would one accomplish this? I know the code above won't work, but is there a way around this? Do I need a Class of Stables to use from the Farm Class? Or do I need a Collection of Stables that's stored somewhere else and named for the farm?

Answer 1

This can be accomplished with the use of two classes: cFarm and cHorse, by making cHorse a property of cFarm

The stables are stored in a dictionary, which is also a property of the cFarm class. You must add Microsoft Scripting Runtime reference library due to this dictionary.

Example of use of the classes to:

• Create a farm
• Add 10 stables
• Populate the stables with horses (all stables are initalized to have a horse)
• Take horses out of some stables (you can write another function to put horses back into a stable)
• Print out (to the immediate window) a list of stables and whether or not it has a horse

The horses are named in this example.

This sub would go into a standard module.

Sub CreateFarm()

    Dim clsFarm As New cFarm

    With clsFarm
        .FarmName = "Smith Farm"
        .AddStables 10

        .TakeHorseOutOfStable 2
        .TakeHorseOutOfStable 5
        .TakeHorseOutOfStable 6
        .TakeHorseOutOfStable 9

        .PrintStableHorseState
    End With

End Sub

Output from the CreateFarm sub

cFarm Class

The cHorse class (defined below this class) is a property of this (cFarm) class. The stables are stored in a dictionary, which is also a property of this class. These properties are set by the class initializer.

Option Explicit

Private pFarmName As String
Private pdictStables As Scripting.Dictionary ' requires Microsoft Scripting Runtime library
Private pHorse As cHorse
Private pNumStables As Integer



Public Property Get FarmName() As String
    FarmName = pFarmName
End Property

Public Property Let FarmName(ByVal sFarmName As String)
    pFarmName = sFarmName
End Property

Public Property Get dictStables() As Scripting.Dictionary
    Set dictStables = pdictStables
End Property

Public Property Set dictStables(ByVal dStable As Scripting.Dictionary)
    Set pdictStables = dStable
End Property

Public Property Get Horse() As cHorse
    Set Horse = pHorse
End Property

Public Property Set Horse(ByVal clsHorse As cHorse)
    Set pHorse = clsHorse
End Property

Public Property Get NumStables() As Integer
    NumStables = pNumStables
End Property

Public Property Let NumStables(ByVal iNumStables As Integer)
    pNumStables = iNumStables
End Property

Sub AddStables(intNumStables As Integer)

    ' all stables are initialized to have a horse

    Dim i As Integer

    With Me
        .NumStables = intNumStables
        For i = 1 To .NumStables

            Set .Horse = New cHorse

            With .Horse
                .HorseName = .HorseNames(i)
                .HasHorse = True
            End With
            .dictStables.Add i, .Horse
        Next i
    End With

End Sub

Sub TakeHorseOutOfStable(intStableNum As Integer)

    With Me
        Set .Horse = .dictStables(intStableNum)
        .Horse.HasHorse = False
        Set .dictStables(intStableNum) = .Horse
    End With

End Sub

Sub PrintStableHorseState()

    Dim vStable As Variant

    With Me.dictStables
        For Each vStable In .Keys
            Debug.Print "Stable number: " & vStable & _
                    "   Horse Name: " & .Item(vStable).HorseName & _
                    "           HasHorse: " & .Item(vStable).HasHorse
        Next vStable
    End With

End Sub

Private Sub Class_Initialize()

    Dim clsHorse As cHorse
    Dim dict As Scripting.Dictionary

    Set clsHorse = New cHorse
    Set Me.Horse = clsHorse

    Set dict = New Scripting.Dictionary
    Set Me.dictStables = dict

End Sub

cHorse class

Option Explicit

Private pHasHorse As Boolean
Private pHorseName As String
Private pHorseNames As Collection

Public Property Get HasHorse() As Boolean
    HasHorse = pHasHorse
End Property

Public Property Let HasHorse(ByVal bHasHorse As Boolean)
    pHasHorse = bHasHorse
End Property

Public Property Get HorseName() As String
    HorseName = pHorseName
End Property

Public Property Let HorseName(ByVal sHorseName As String)
    pHorseName = sHorseName
End Property

Public Property Get HorseNames() As Collection
    Set HorseNames = pHorseNames
End Property

Public Property Set HorseNames(ByVal colHorseNames As Collection)
    Set pHorseNames = colHorseNames
End Property

Private Function GetHorseNames() As Collection

    Dim colHorseNames As New Collection

    With colHorseNames
        .Add "Secretariat"
        .Add "Man O' War"
        .Add "Seabiscuit"
        .Add "Phar Lap"
        .Add "Frankel"
        .Add "Black Caviar"
        .Add "Ruffian"
        .Add "Citation"
        .Add "Zenyatta"
        .Add "Seattle Slew"
    End With

    Set GetHorseNames = colHorseNames

End Function

Private Sub Class_Initialize()

    Dim colHorseNames As New Collection

    Set Me.HorseNames = GetHorseNames()

End Sub

Answer 2

Array approach would force you to handle the "zero state", while a Dictionary approach could let you handle stables more efficiently by wrapping its members and methods in your class ones

like follows

---

Farm Class code

Option Explicit

Public FarmName As String
Private Stables As Scripting.Dictionary

Public Property Get NumberOfStables() As Long
    NumberOfStables = Stables.Count
End Property

Public Sub AddStables(ByVal stablesNr As Long)
    Dim i As Long
    For i = 1 To stablesNr
        Stables.Add Stables.Count + 1, 0
    Next
End Sub

Public Sub AddStable()
    Me.AddStables 1
End Sub

Public Sub RemoveStable()
    If Stables.Count > 0 Then Stables.Remove Stables.Count
End Sub

Public Sub GetHorsesFromStable(ByVal stableNr As Long, ByVal horsesToRemove As Long)
    If Stables.Exists(stableNr) Then If horsesToRemove > 0 Then Stables(stableNr) = IIf(Stables(stableNr) - horsesToRemove >= 0, Stables(stableNr) - horsesToRemove, 0)
End Sub

Public Sub GetHorseFromStable(ByVal stableNr As Long)
    If Stables.Exists(stableNr) Then Me.GetHorsesFromStable stableNr, 1
End Sub

Public Sub AddHorsesToStable(ByVal stableNr As Long, ByVal horsesToAdd As Long)
    If Stables.Exists(stableNr) Then If horsesToAdd > 0 Then Stables(stableNr) = Stables(stableNr) + horsesToAdd
End Sub

Public Sub AddHorseToStable(ByVal stableNr As Long)
    If Stables.Exists(stableNr) Then Me.AddHorsesToStable stableNr, 1
End Sub

Public Property Get HasHorse(ByVal stableNr As Long) As Boolean
    If Stables.Exists(stableNr) Then HasHorse = Stables(stableNr) > 0
End Property

Public Property Get stableHorses(ByVal stableNr As Long) As Long
    If Stables.Exists(stableNr) Then stableHorses = Stables(stableNr)
End Property

Public Property Get currentHorses() As Long
    Dim horses As Variant
    For Each horses In Stables.Items
        currentHorses = currentHorses + horses
    Next
End Property


Private Sub Class_Initialize()
    Set Stables = New Scripting.Dictionary
End Sub

---

your Farm class exploiting

Option Explicit

Sub FarmTest()
    Dim smithFarm As New Farm

    With smithFarm
        .AddStables 3 '<--| add stables
        Debug.Print .NumberOfStables '<--| returns three
        Debug.Print .currentHorses '<--| returns zero
        Debug.Print .HasHorse(1) '<--| returns False
        Debug.Print .HasHorse(2) '<--| returns False
        Debug.Print .HasHorse(3) '<--| returns False

        Debug.Print ""

        .AddHorsesToStable 1, 2 '<--| add stable 1 two horses
        Debug.Print .currentHorses '<--| returns two
        Debug.Print .HasHorse(1) '<--| returns True
        Debug.Print .stableHorses(1) '<--| returns two
        Debug.Print .HasHorse(2) '<--| returns False
        Debug.Print .stableHorses(2) '<--| returns zero

        Debug.Print ""

        .AddHorsesToStable 2, 1 '<--| add stable 2 one horse
        Debug.Print .currentHorses '<--| returns three
        Debug.Print .HasHorse(2) '<--| returns True
        Debug.Print .stableHorses(2) '<--| returns one
        Debug.Print .HasHorse(3) '<--| returns False
        Debug.Print .stableHorses(3) '<--| returns zero

        Debug.Print ""

        .AddHorsesToStable 3, 2 '<--| add stable 3 two horses
        Debug.Print .currentHorses '<--| returns five
        Debug.Print .HasHorse(3) '<--| returns True
        Debug.Print .stableHorses(3) '<--| returns three

    End With

End Sub

Answer 3

A.S.H.'s answer would work well and is a good example of Property Let and Property Get.

OOP 'purists' might say you need the two classes: Farm and Stables. It really depends on how complex your structure will become. Below is a very basic two class structure that you could start with:

The Farm class (called clsFarm):

Public FarmName As String
Public Stables As Collection

Public Property Get HorseCount() As Long
    Dim oStable As clsStable

    If Not Me.Stables Is Nothing Then
        For Each oStable In Me.Stables
            If oStable.HasHorse Then
                HorseCount = HorseCount + 1
            End If
        Next
    End If
End Property

Public Property Get Stable(stableRef As String) As clsStable
    Set Stable = Stables(stableRef)
End Property

The Stable class (called clsStable):

Public StableRef As String
Public HasHorse As Boolean

You could populate the classes in a Module:

Dim oFarm As clsFarm
Dim oStable As clsStable

Set oFarm = New clsFarm
With oFarm
    .FarmName = "Smith Farm"
    Set .Stables = New Collection
End With

Set oStable = New clsStable
With oStable
    .StableRef = "1"
    .HasHorse = True
End With
oFarm.Stables.Add oStable, oStable.StableRef

Set oStable = New clsStable
With oStable
    .StableRef = "2"
    .HasHorse = False
End With
oFarm.Stables.Add oStable, oStable.StableRef

Set oStable = New clsStable
With oStable
    .StableRef = "3"
    .HasHorse = True
End With
oFarm.Stables.Add oStable, oStable.StableRef

And then manipulate the data as required, eg.:

MsgBox oFarm.HorseCount

If Not oFarm.Stable("2").HasHorse Then MsgBox "Bolted!"

Answer 4

You can make the HasHorse an Array of Boolean. But you will face a problem, that is, you need to have your array's size consistent with the NumberOfStables property. Therefore, dont manage a NumberOfStables properrty, just a getter that returns the size of the array. This is where comes the need for setters and getters of your class.

' Code for the Farm Class
Option Explicit

Public FarmName As String
Private mStables() As Boolean

Public Property Get NumberOfStables() As Long
  NumberOfStables = UBound(mStables)
End Property

Public Property Let NumberOfStables(ByVal n As Long)
      ReDim Preserve mStables(1 To n)
End Property

Public Property Get HasHorse(ByVal i As Long) As Boolean
    HasHorse = mStables(i)
End Property

Public Property Let HasHorse(ByVal i As Long, ByVal b As Boolean)
    mStables(i) = b
End Property

Public Property Get currentHorses() As Long
    Dim i As Long
    For i = 1 To NumberOfStables
        If HasHorse(i) Then currentHorses = currentHorses + 1
    Next
End Property

Here's some testing, in a normal code Module:

Sub FarmTesting()
    Dim smithFarm As New Farm

    smithFarm.NumberOfStables = 3
    Debug.Print smithFarm.NumberOfStables
    smithFarm.HasHorse(2) = True

    Debug.Print smithFarm.HasHorse(1), smithFarm.HasHorse(2), smithFarm.HasHorse(3)

    smithFarm.NumberOfStables = 2
    Debug.Print smithFarm.HasHorse(1), smithFarm.HasHorse(2)

    Debug.Print smithFarm.currentHorses
End Sub