How do I declare Static variable for Class Module in VBA?

Question

I want to keep track of all instances of a Particular Class in Excel-VBA, like Static Member in VB.Net. So here is my Class Module:

ClassModule: clsClass

Private pName as String
'Static pCount Commented as it doesnt work

Property Set Name(arg as String)
    pName=arg
End Property

Private Sub Class_Initialize()
    'pCount = pCount + 1  Commented as it doesnt work 
End Sub

Public Function GetCount()
    GetCount = pCount
End Function

and my Generic Module Module: Module1

Sub ABC()

Dim instance1 As New clsClass
Dim instance2 As New clsClass
Dim instance3 As New clsClass
Dim instance4 As New clsClass
'Debug.Print instance4.GetCount() This Should Return 4, but doesnt
End Sub

What am I doing Wrong ? How do i declare a variable that is shared across all of instances ?

Answer 1

Smallest code

Based on logic described in Class (Static) Methods in VBA.

The static property StaticCount is incremented in the Constructor method. The most important code to support the static attributes is mentioned in the Get and Let Property procedures (If Singleton Is Nothing Then ... Else ... End If).

The drawback here is that it uses End to clear the global/static variables so that it prints 2 every time you call ABC, but it also clears all global variables of the VBProject that you may not wish. If End is not used, it would print 2, 4, 6, +2 each time you call ABC. See a workaround in the next chapter.

Module Module1:

Sub ABC()
    Set instance1 = New_clsClass()
    Set instance2 = New_clsClass()
    Debug.Print "Result: " & instance1.StaticCount 'This returns 2
    End ' Reset Global/Static memory to clear "Static Singleton" (and whole VBProject memory)
End Sub

Function New_clsClass() As clsClass
    Set Object = New clsClass
    Static Singleton As clsClass
    If Singleton Is Nothing Then
        Set Singleton = New clsClass
    End If
    Set Object.Singleton = Singleton
    Call Object.Constructor
    Set New_clsClass = Object
End Function

Class Module clsClass:

Private StaticCount_ As Integer
Private Singleton_ As clsClass

Private Static Property Get Singleton() As Object
    Set Singleton = Singleton_
End Property

Private Property Set Singleton(Object As Object)
    Set Singleton_ = Object
End Property

Public Property Get StaticCount() As Integer
    If Singleton Is Nothing Then
        StaticCount = StaticCount_
    Else
        StaticCount = Singleton.StaticCount
    End If
End Property

Private Property Let StaticCount(value As Integer)
    If Singleton Is Nothing Then
        StaticCount_ = value
    Else
        Singleton.StaticCount = value
    End If
End Property

Public Sub Constructor()
    StaticCount = StaticCount + 1
End Sub

Smallest code + way to control what Global/Static variables you reset, instead of using End

This solution is based on a global variable which retains the singletons, so you may reset the singletons when you run ABC. Here, all singletons are reset except the ones of the classes clsClass74 and clsClass75 which are to keep their static properties alive "all the time".

Module Module1:

Global goSingletons As New Collection

Sub ABC()
    Call ResetGlobalMemory
    Set instance1 = New_clsClass()
    Set instance2 = New_clsClass()
    Debug.Print "Result: " & instance1.StaticCount 'This returns 2
End Sub

Sub ResetGlobalMemory()
    ' Reset all singletons except the one of clsClass7
    For i = goSingletons.count To 1 Step -1
        Select Case TypeName(goSingletons(i))
            Case "clsClass74", "clsClass75"
            Case Else
                Call goSingletons.Remove(i)
        End Select
    Next
End Sub

Function New_clsClass() As clsClass
    Set Object = New clsClass
    Set Object.Singleton = GetSingleton("clsClass")
    Call Object.Constructor
    Set New_clsClass = Object
End Function

Function GetSingleton(ClassName As String)
    On Error Resume Next
    Set Singleton = goSingletons(ClassName)
    If Err.Number <> 0 Then
        On Error GoTo 0
        Select Case ClassName
            Case "clsClass": Set Singleton = New clsClass
            Case "clsClass2": Set Singleton = New clsClass2
            Case Else: Err.Raise 9999, , "Singleton not managed by class " & ClassName
        End Select
        Call goSingletons.Add(Singleton, ClassName)
    End If
    Set GetSingleton = Singleton
End Function

Class Module clsClass:

Private StaticCount_ As Integer
Private Singleton_ As clsClass

Private Static Property Get Singleton() As Object
    Set Singleton = Singleton_
End Property

Private Property Set Singleton(Object As Object)
    Set Singleton_ = Object
End Property

Public Property Get StaticCount() As Integer
    If Singleton Is Nothing Then
        StaticCount = StaticCount_
    Else
        StaticCount = Singleton.StaticCount
    End If
End Property

Private Property Let StaticCount(value As Integer)
    If Singleton Is Nothing Then
        StaticCount_ = value
    Else
        Singleton.StaticCount = value
    End If
End Property

Public Sub constructor()
    StaticCount = StaticCount + 1
End Sub

Smallest code + argument to constructor

(proposed here just in case you are not sure how to mix the solution of passing arguments to constructor in VBA with the code above)

Module Module1:

Sub ABC()
    Set instance1 = New_clsClass(41)
    Set instance2 = New_clsClass(42)
    Debug.Print "Result: " & instance1.StaticCount 'This returns 2
    End ' Reset Global/Static memory to clear "Static Singleton" (and whole VBProject memory)
End Sub

Function New_clsClass(arg1 As Integer) As clsClass
    Set Object = New clsClass
    Static Singleton As clsClass
    If Singleton Is Nothing Then
        Set Singleton = New clsClass
    End If
    Set Object.Singleton = Singleton
    Call Object.Constructor(arg1)
    Set New_clsClass = Object
End Function

Class Module clsClass:

Private arg1_ As Integer
Private StaticCount_ As Integer
Private Singleton_ As clsClass

Private Static Property Get Singleton() As Object
    Set Singleton = Singleton_
End Property

Private Property Set Singleton(Object As Object)
    Set Singleton_ = Object
End Property

Public Property Get StaticCount() As Integer
    If Singleton Is Nothing Then
        StaticCount = StaticCount_
    Else
        StaticCount = Singleton.StaticCount
    End If
End Property

Private Property Let StaticCount(value As Integer)
    If Singleton Is Nothing Then
        StaticCount_ = value
    Else
        Singleton.StaticCount = value
    End If
End Property

Public Function Constructor(arg1 As Integer)
    arg1_ = arg1
    StaticCount = StaticCount + 1
End Function