1
\$\begingroup\$

I have noticed this question https://stackoverflow.com/questions/49389392/nested-classes-and-collections-vba in StackOverflow, but it got closed faster than I could have answered. However, it was concerning a best practice for usage of collections of classes.

I usually use Array and I add to it like this:

Public Sub AddToTeam(emp As Employee)

    Dim cnt As Long
    cnt = UBound(pTeam)

    If Not pTeam(0) Is Nothing Then
        ReDim Preserve pTeam(cnt + 1)
        cnt = cnt + 1
    End If
    Set pTeam(cnt) = emp

End Sub

Furthermore, I initialize the Array like this in the class:

Private Sub Class_Initialize()
    ReDim pTeam(0)
End Sub

This is the working code, feel free to give any ideas:

Main Module

Option Explicit

Public Sub TestMe()

    Dim EmpA    As New Employee
    Dim EmpB    As New Employee
    Dim ManA    As New Employee
    Dim TeamA   As New Team

    ManA.Name = "John Doe Top Manager"
    EmpA.Name = "Peter"
    EmpB.Name = "George"

    Set EmpB.Manager = ManA
    TeamA.Name = "The best team!"

    TeamA.AddToTeam ManA
    TeamA.AddToTeam EmpA
    TeamA.AddToTeam EmpB

    TeamA.PrintNames
    Debug.Print TeamA.Name
    TeamA.PrintInfoForManagers

End Sub

Class Employee

Option Explicit

Private pName           As String
Private pManager        As Employee
Private pAge            As Long
Private pTeam           As String
Private pHasManager     As Boolean

Public Property Get HasManager() As Boolean
    HasManager = pHasManager
End Property

Public Property Let HasManager(Value As Boolean)
    pHasManager = Value
End Property

Public Property Get Manager() As Employee
    Set Manager = pManager
End Property

Public Property Set Manager(Value As Employee)
    Set pManager = Value
    HasManager = True
End Property

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

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

Public Property Get Team() As Employee
    Team = pTeam
End Property

Public Property Let Team(Value As Employee)
    pTeam = Value
End Property

Class Team

Option Explicit

Private pTeam()         As Employee
Private pName           As String

Public Sub PrintInfoForManagers()

    Dim emp As Variant
    For Each emp In pTeam
        If emp.HasManager Then
            Debug.Print emp.Name & " is managed by " & emp.Manager.Name
        Else
            Debug.Print emp.Name & " has no manager."
        End If
    Next emp

End Sub

Public Sub PrintNames()

    Dim emp As Variant
    For Each emp In pTeam
        Debug.Print emp.Name
    Next emp

End Sub

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

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

Public Sub AddToTeam(emp As Employee)

    Dim cnt As Long
    cnt = UBound(pTeam)

    If Not pTeam(0) Is Nothing Then
        ReDim Preserve pTeam(cnt + 1)
        cnt = cnt + 1
    End If
    Set pTeam(cnt) = emp

End Sub

Private Sub Class_Initialize()
    ReDim pTeam(0)
End Sub

So how would you review/improve it?

\$\endgroup\$
0
2
\$\begingroup\$

I prefer not to initiate arrays until they're needed. Automatically initiating your array can make it difficult to determine whether the array has been used. Using the Team class as an example, calling PrintNames before any names are added will throw an error.

Private Sub Class_Initialize()
    ReDim pTeam(0)
End Sub

The main reason this is done is to avoid throwing an error when checking to whether or not an array has been initialized.

There is a trick to avoid the error 9, Subscript out of range. Checking to see if an array IsEmpty() on an uninitialized array will cause UBound() to return -1.

By using Call IsEmpty(pTeam) instead of ReDim pTeam(0) we can easily check whether the array has actually been used using If UBound(pTeam) = -1 Then.

Private Sub Class_Initialize()
    Call IsEmpty(pTeam)
End Sub

Public Sub AddToTeam(emp As Employee)
    If UBound(pTeam) = -1 Then
        ReDim pTeam(0)
    Else
        ReDim Preserve pTeam(UBound(pTeam) + 1)
    End If
    Set pTeam(UBound(pTeam)) = emp
End Sub

Alternatively, we could write a function to check if the array has been used.

Public Function hasMembers()
    Call IsEmpty(pTeam)
    hasMembers = UBound(pTeam) > -1
End Function

Using a Private Type to Reference Class Members

Mathieu Guindon (formally known as Mat's Mug) likes to use a User Defined Type (UDT) named This to reference class level variables. I have adopted the technique but name it vars instead of This. In this way you can avoid having to the class variable names different from the parameter names (see code below).

Refactored Code

Employee:Class

Option Explicit

Private Type Variables
    Name As String
    Manager As Employee
    Age As Long
    Team As String
End Type

Private vars As Variables

Public Function HasManager() As Boolean
    HasManager = Not vars.Manager Is Nothing
End Function

Public Property Get Manager() As Employee
    Set Manager = vars.Manager
End Property

Public Property Set Manager(Value As Employee)
    Set vars.Manager = Value
End Property

Public Property Get Name() As String
    Name = vars.Name
End Property

Public Property Let Name(Value As String)
    vars.Name = Value
End Property

Public Property Get Team() As Employee
    Team = vars.Team
End Property

Public Property Let Team(Value As Employee)
    vars.Team = Value
End Property

Public Function This() As Team
    Set This = Me
End Function

Team:Class

Option Explicit

Private Type Variables
    Team() As Employee
    Name As String
End Type
Private vars As Variables

Public Sub PrintInfoForManagers()

    Dim emp As Variant
    For Each emp In vars.Team
        If emp.HasManager Then
            Debug.Print emp.Name & " is managed by " & emp.Manager.Name
        Else
            Debug.Print emp.Name & " has no manager."
        End If
    Next emp

End Sub

Public Sub PrintNames()
    Dim emp As Variant
    If UBound(vars.Team) = -1 Then
        Debug.Print "There are no Names to Print"
    Else
        For Each emp In vars.Team
            Debug.Print emp.Name
        Next emp
    End If

End Sub

Public Property Get Name() As String
    Name = vars.Name
End Property

Public Property Let Name(Value As String)
    vars.Name = Value
End Property

Public Sub AddToTeam(emp As Employee)
    If Not Me.hasMembers Then
        ReDim vars.Team(0)
    Else
        ReDim Preserve vars.Team(UBound(vars.Team) + 1)
    End If
    Set vars.Team(UBound(vars.Team)) = emp
End Sub

Public Function hasMembers()
    Call IsEmpty(vars.Team)
    hasMembers = UBound(vars.Team) > -1
End Function

Public Function This() As Team
    Set This = Me
End Function
\$\endgroup\$
4
  • \$\begingroup\$ Interesting ideas, thanks, Class_Initialize really somehow smells. In general, why are you using Call? I thought this was one of the "forbidden" VBA features, just like Integer. A separate Thumbs Up for the Enums. It looks a bit clearer than the automatic pVariable from MZ-Code. \$\endgroup\$
    – Vityata
    Mar 21 '18 at 9:29
  • 1
    \$\begingroup\$ Call IsEmpty (vars.Team) looks more natural then IsEmpty vars.Team to me. Although there is no speed advantage to using Integer instead of Long, I would not call Integer a "forbidden" fracture. You mean User Defined Typesnot Enums but thanks! \$\endgroup\$
    – user109261
    Mar 21 '18 at 9:43
  • \$\begingroup\$ Yup, I meant User Defined Types. :) \$\endgroup\$
    – Vityata
    Mar 21 '18 at 9:46
  • \$\begingroup\$ This is gold - There is a trick to avoid the error 9, Subscript out of range. Checking to see if an array IsEmpty() on an uninitialized array will cause UBound() to return -1. My vote of: abs(UBound(vars.Team)) \$\endgroup\$ Oct 12 '18 at 10:24
2
\$\begingroup\$

I don't see the need for the HasManager property. Either a Manager is assigned, or not. It wouldn't make sense for you to set it to True when there isn't one, or False when there is.

Then just change your Print function to check -

If Not emp.Manager Is Nothing Then
    Debug.Print emp.Name & " is managed by " & emp.Manager.Name
 Else
    Debug.Print emp.Name & " has no manager."

If it was easy to overload the class initialization for employee, I'd say make a name value obligatory, but it's really not a simple task in VBA.


These two properties:

Public Property Get Team() As Employee
    Team = pTeam
End Property

Public Property Let Team(Value As Employee)
    pTeam = Value
End Property

Are passing Objects - why not pass Strings given the team information is handled by a string.

\$\endgroup\$
2
  • 1
    \$\begingroup\$ Both are good ideas, thanks. However, I like the HasManager, it somehow gives me some kind of an interface to work with. Not Is Nothing is a good way around. Team is assigned as employee, because I can use some other properties later (probably). \$\endgroup\$
    – Vityata
    Mar 21 '18 at 9:23
  • 1
    \$\begingroup\$ Passing string Names for the managers instead of Employee objects defeats the purpose of the post. Consider that you add and email field to the Employee class and needed to retrieve the Email address of an employees manager. Currently you could simply use Employee.Manager.Email . If you use string then you would have to iterate over all the managers to find the Email address. \$\endgroup\$
    – user109261
    Mar 21 '18 at 9:28

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.