How to incorporate Excel VBA class collection into interface/factory method?

Question

I've been using class modules for almost a year, and I'm just now comfortable with them. Now I'm trying to incorporate factory methods into data extraction from workbook tables. I found some great guides on the topic here, here, and here, but I'm unsure where to incorporate a collection of the class.

Up until now, I've setup my class modules with self-contained collections in this format:

Class module OrigClass

Option Explicit

'Col position references for input table, only includes cols with relevant data
Private Enum icrColRef
    icrName = 2
    icrCost = 4
End Enum

'UDT mirrors class properties
Private Type TTestClass
    Name                                As String
    Cost                                As Long
End Type

Const WS_NAME                           As String = "Sheet1"
Const NR_TBL                            As String = "Table1"

Private msTestClass                     As Collection
Private TestClass                       As TTestClass


Private Sub Class_Initialize()
    Set msTestClass = New Collection
End Sub

Public Sub Add(Item As OrigClass)
    msTestClass.Add _
        Item:=Item, _
        Key:=Item.Name
End Sub

Public Function Extract() As OrigClass
    Dim tblInputs                       As ListObject
    Dim i                               As Integer
    Dim Item                            As OrigClass

    Set tblInputs = ThisWorkbook.Worksheets(WS_NAME).ListObjects(NR_TBL)

    For i = 1 To tblInputs.DataBodyRange.Rows.Count
        Set Item = New OrigClass
        
        With Item
            .Name = tblInputs.DataBodyRange(i, icrName).Value
            .Cost = tblInputs.DataBodyRange(i, icrCost).Value
        End With

        msTestClass.Add Item
    Next i
End Function

Public Function Item(i As Variant) As OrigClass
    Set Item = msTestClass.Item(i)
End Function

Public Function Count() As Integer
    Count = msTestClass.Count
End Function


Friend Property Let Name(Val As String)
    TestClass.Name = Val
End Property

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

Friend Property Let Cost(Val As Long)
    TestClass.Cost = Val
End Property

Public Property Get Cost() As Long
    Cost = TestClass.Cost
End Property

This structure works well when I build functions that pass a ranges/table, loop through the rows, and assign a column value to each property. The address is almost always constant and only the values and record count will vary.

I just started building an interface for a class while also trying to retain the collection component, but I'm stumbling on runtime errors... I could possibly create a separate collection class, but I think my problem is more about mismanaging scope rather than encapsulation:

Class module CTestClass

Option Explicit

'Col position references for input table, only includes cols with relevant data
Private Enum icrColRef
    icrName = 2
    icrCost = 4
End Enum

''UDT mirrors class properties
Private Type TTestClass
    Name                                As String
    Cost                                As Long
End Type

Const WS_NAME                           As String = "Sheet1"
Const NR_TBL                            As String = "Table1"

Private msTestClass                     As Collection
Private TestClass                       As TTestClass

Implements ITestClass
Implements FTestClass


Private Sub Class_Initialize()
    Set msTestClass = New Collection
End Sub

Public Sub Add(Item As CTestClass)
    msTestClass.Add _
        Item:=Item, _
        Key:=Item.Name
End Sub

Public Function Create() As ITestClass
    With New CTestClass
        .Extract
' 2) now in Locals window, Me.msTestClass is <No Variables>
        Set Create = .Self
' 4) Me.msTestClass is again <No Variables>, and
'       Create (as Type ITextClass) is Nothing
'       Create (as Type ITextClass/ITextClass) lists property values as
'           <Object doesn't support this property or method>, aka runtime error 438
    End With
End Function

Private Function FTestClass_Create() As ITestClass
    Set FTestClass_Create = Create
End Function

Public Function Extract() As ITestClass
    Dim tblInputs                       As ListObject
    Dim i                               As Integer
    Dim Item                            As CTestClass

    Set tblInputs = ThisWorkbook.Worksheets(WS_NAME).ListObjects(NR_TBL)

    For i = 1 To tblInputs.DataBodyRange.Rows.Count
        Set Item = New CTestClass
        
        With Item
            .Name = tblInputs.DataBodyRange(i, icrName).Value
            .Cost = tblInputs.DataBodyRange(i, icrCost).Value
        End With

        msTestClass.Add Item
    Next i
' 1) in Locals window, Me.msTestClass is populated with all table records
End Function

Public Function ITestClass_Item(i As Variant) As ITestClass
    Set ITestClass_Item = msTestClass.Item(i)
End Function

Public Function ITestClass_Count() As Integer
    ITestClass_Count = msTestClass.Count
End Function


Friend Property Let Name(Val As String)
    TestClass.Name = Val
End Property

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

Friend Property Let Cost(Val As Long)
    TestClass.Cost = Val
End Property

Public Property Get Cost() As Long
    Cost = TestClass.Cost
End Property


Public Property Get Self() As ITestClass
    Set Self = Me
' 3) Me.msTestClass is again populated with all table records (scope shift?), but
'       Self is set to Nothing
End Property

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

Private Property Get ITestClass_Cost() As Long
    ITestClass_Cost = Cost
End Property

Interface module ITestClass

'Attribute VB_PredeclaredId = False     <-- revised in text editor
Option Explicit


Public Function Item(i As Variant) As ITestClass
End Function

Public Function Count() As Integer
End Function


Public Property Get Name() As String
End Property

Public Property Get Cost() As Long
End Property

Factory module FTestClass

'Attribute VB_PredeclaredId = False     <-- revised in text editor
Option Explicit


Public Function Create() As ITestClass
End Function

Standard module

Sub TestFactory()
    Dim i                               As ITestClass
    Dim oTest                           As FTestClass
    
    Set oTest = CTestClass.Create
' 5) oTest is <No Variables>, no properties are present
'       as if the variable was never set
    
    For Each i In oTest     ' <-- Runtime error 438, Object doesn't support this property or method
        Debug.Print
        Debug.Print i.Name
        Debug.Print i.Cost
    Next i
End Sub

What am I doing wrong here?

EDIT:

@freeflow pointed out that I didn't state my intentions for introducing an interface.

My office uses several workbook "models" to compile pricing data into a single output table that is then delivered to a downstream customer for importing into a database.

My goal is to standardize the calculations using these various models. The side goal is to understand how to properly implement a factory method.

Each model has one or more input tables, and each table contains a unique collection of 10-30 fields/columns. The output data calculations vary, along with the dependencies on various input fields. However, the output data is the same format all across the board and always contains the same dozen fields.

The example I've shown is intended to be a single interface ITestClass for writing data to the output table. The class that implements it CTestClass can be considered as just one of the several tables (within the several models) containing the input data. I plan on modeling more class objects, one for each input table.

Answer 1

Based on:

Sub TestFactory()
    Dim i                               As ITestClass
    Dim oTest                           As FTestClass
    
    Set oTest = CTestClass.Create
' 5) oTest is <No Variables>, no properties are present
'       as if the variable was never set
    
    For Each i In oTest     ' <-- Runtime error 438, Object doesn't support this property or method
        Debug.Print
        Debug.Print i.Name
        Debug.Print i.Cost
    Next i
End Sub

It would appear that you are interested in making your class iterable like a collection. I would point you towards this SO question. The short of it is...it's difficult.

WIth regard to the error: The result of statement Set oTest = CTestClass.Create is the acquisition of a FTestClass interface that exposes a single method: Public Function Create() As ITestClass. Which, provides nothing to iterate on and results in an error.

Other Observations:

In the code as provided, there is no need to declare a factory interface.

(Sidebar: Interface classes typically begin with the letter "I". In this case, a better interface name for FTestClass would be "ITestClassFactory")

Since CTestClass has its VB_PredeclaredId attribute set to 'True', any Public method (or field) declared in CTestClass is exposed...and is considered its default interface. CTestClass.Create() is the Factory method you are interested in.

One purpose of creating a Factory method (in VBA) is to support the parameterized creation of a class instance. Since the Create function currently has no parameters, it is unclear what else could be going on during creation other than Set tClass = new CTestClass. But, there are parameters that would indicate what is going on during Create.

Public Function Create(ByVal tblInputs As ListObject, OPtional ByVal nameColumn As Long = 2, Optional ByVal costColumn As Long = 4) As ITestClass

In other words, CTestClass has a dependency on a ListObject in order to become a valid instance of a CTestClass. A factory method's signature typically contains dependencies of the class. With the above factory method, there is no longer a need to have an Extract function - Public or otherwise. Notice also (in the code below) that the ThisWorkbook reference is no longer part of the object. Now, the tblInputs ListObject can be from anywhere. And the important column numbers can be easily modified. This parameter list allows you to test this class using worksheets with fake data.

Reorganizing:

CTestClass contains a Collection of CTestClass instances. It would seem clearer to declare a TestClassContainer class that exposes the Create function above. The container class can then expose a NameCostPairs property which simply exposes the msTestClass Collection. Creating a container class reduces the TestClass to essentially a data object (all Properties, no methods) which results in a useful separation of concerns. Let the calling objects handle the iteration of the collection.

TestClassContainer

Option Explicit

Private Type TTestClassContainer
    msTestClass As Collection
End Type

Private this                       As TTestClassContainer

'TestContainer Factory method
Public Function Create(ByVal tblInputs As ListObject, Optional ByVal nameCol As Long = 2, Optional ByVal costCol As Long = 4) As TestClassContainer
    Dim i As Integer
    Dim nameCostPair As CTestClass
    
    Dim newInstance As TestClassContainer

    With New TestClassContainer
        Set newInstance = .Self
        For i = 1 To tblInputs.DataBodyRange.Rows.Count
            Set nameCostPair = New CTestClass
            nameCostPair.Name = tblInputs.DataBodyRange(i, nameCol).Value
            nameCostPair.Cost = tblInputs.DataBodyRange(i, costCol).Value
            
            newInstance.AddTestClass nameCostPair
        Next i
    End With
    
    Set Create = newInstance
    
End Function

Public Sub AddTestClass(ByVal tstClass As CTestClass)
    this.msTestClass.Add tstClass
End Sub

Public Property Get Self() As CTestClass
    Set Self = Me
End Property

Public Property Get NameCostPairs() As Collection
    Set NameCostPairs = this.msTestClass
End Property

CTestClass (no longer needs VB_PredeclaredId set to 'True')

Option Explicit

Implements ITestClass

''UDT mirrors class properties
Private Type TTestClass
    Name As String
    Cost As Long
End Type

Private this As TTestClass

Public Property Let Name(Val As String)
    this.Name = Val
End Property

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

Public Property Let Cost(Val As Long)
    this.Cost = Val
End Property

Public Property Get Cost() As Long
    Cost = this.Cost
End Property

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

Private Property Get ITestClass_Cost() As Long
    ITestClass_Cost = Cost
End Property

And Finally:

Option Explicit

Sub TestFactory()
    Const WS_NAME As String = "Sheet1"
    Const NR_TBL As String = "Table1"
    
    Dim tblInputs As ListObject

    Set tblInputs = ThisWorkbook.Worksheets(WS_NAME).ListObjects(NR_TBL)

    Dim container As TestClassContainer
    Set container = TestClassContainer.Create(tblInputs)
    
    Dim nameCostPair As ITestClass
    Dim containerItem As Variant
    For Each containerItem In container.NameCostPairs
        Set nameCostPair = containerItem
        Debug.Print
        Debug.Print nameCostPair.Name
        Debug.Print nameCostPair.Cost
    Next
End Sub

Answer 2

I see @BZgr has provided a solution but as I'd also written one I provide the answer below as analternative.

I think there are several problems with th OP code.

1. The origclass and collection of origclasses is conflated, they should be separate. Disentangling this wasn't made easier by the poor naming of the origclass UDT.

2. Its not clear what needs to be a factory. I've put the factory method in the origclasses class so that an 'immutable' collection of origclass is created.

3. Its not clear what the op is trying to achieve by introducing an interface. In general, interfaces are used when a number of different object must provide that same set of methods. In VBA the interface declaration allows the compiler to check if each object that claims to implement the interface has the correct methods and parameter lists. (but i do accept that there may be some special VBA cases where this is not the case)

The code below compiles and has no significant Rubberduck inspections. However, I am not a user of Excel VBA so I apologise in advance if my code makes mistakes in this area.

a. We have a separate and very simple OrigClass

Option Explicit

Private Type Properties

    Name                                As String
    Cost                                As Long

End Type

Private p                               As Properties


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

Public Property Let Name(ByVal ipString As String)
    p.Name = ipString
End Property


Public Property Get Cost() As Long
    Cost = p.Cost
End Property

Public Property Let Cost(ByVal ipCost As Long)
    p.Cost = ipCost
End Property

2 The OrigClaases class which is a collection of origclass

Option Explicit
'@PredeclaredId
'@Exposed

'Col position references for input table, only includes cols with relevant data
Private Enum icrColRef
    icrName = 2
    icrCost = 4
End Enum


Private Type State

    'TestClass                     As Collection
    Host                                As Collection
    ExternalData                        As Excel.Worksheet
    TableName                           As String
    
End Type

Private s                               As State


Public Function Deb(ByVal ipWorksheet As Excel.Worksheet, ByVal ipTableName As String) As OrigClasses

    With New OrigClasses
    
        Set Deb = .ReadyToUseInstance(ipWorksheet, ipTableName)
    
    End With
    
End Function

Friend Function ReadyToUseInstance(ByVal ipWorksheet As Excel.Worksheet, ByVal ipTableName As String) As OrigClasses

    Set s.Host = New Collection
    Set s.ExternalData = ipWorksheet
    s.TableName = ipTableName
    PopulateHost
    Set ReadyToUseInstance = Me
    
End Function


' The fact that you are using the collection Key suggests
' you might be better of using a scripting.dictioanry
' Also given that you populate host doirectly from the worksheet
' this add method may now be redundant.

Public Sub Add(ByVal ipItem As OrigClass)

    s.Host.Add _
        Item:=ipItem, _
        Key:=ipItem.Name
        
End Sub

Public Sub Extract()
    ' Extract is restricted to re extracting data
    ' should the worksheet have been changed.
    ' If you need to work on a new sheet then
    ' create a new OrigClasses object
    
    Set s.Host = New Collection
    PopulateHost
    
End Sub

Private Sub PopulateHost()
    
    Dim tblInputs As ListObject
    Set tblInputs = s.ExternalData.ListObjects(s.TableName)

    Dim myRow As Long
    For myRow = 1 To tblInputs.DataBodyRange.Rows.Count
    
        Dim myItem As OrigClass
        Set myItem = New OrigClass
        
        With myItem
        
            .Name = tblInputs.DataBodyRange(myRow, icrName).Value
            .Cost = tblInputs.DataBodyRange(myRow, icrCost).Value
            
        End With

        s.Host.Add myItem, myItem.Name
        
    Next
    
End Sub

Public Function Item(ByVal ipIndex As Variant) As OrigClass
    Set Item = s.Host.Item(ipIndex)
End Function

Public Function Count() As Long
    Count = s.Host.Count
End Function

Public Function Name(ByVal ipIndex As Long) As String
    Name = s.Host.Item(ipIndex).Name
End Function

Public Function Cost(ByVal ipIndex As Long) As Long
    Cost = s.Host.Item(ipIndex).Cost
End Function

Public Function SheetName() As String
    SheetName = s.ExternalData.Name
End Function

Public Function TableName() As String
    TableName = s.TableName
End Function

'@Enumerator
Public Function NewEnum() As IUnknown
    Set NewEnum = s.Host.[_NewEnum]
End Function

c. The testing code

Option Explicit
Const WS_NAME                           As String = "Sheet1"
Const NR_TBL                            As String = "Table1"

Sub TestFactory()
    
    Dim oTest As OrigClasses
    '@Ignore UnassignedVariableUsage
    Set oTest = OrigClasses.Deb(ThisWorkbook.Worksheets(WS_NAME), NR_TBL)
    
    Dim myOrigClass As Variant

    For Each myOrigClass In oTest
    
        Debug.Print
        Debug.Print myOrigClass.Name
        Debug.Print myOrigClass.Cost
        
    Next
    
End Sub

For the factory method, following feeback from Rubberduck, I now use the method name 'Deb' which is short for Debut (or Debutante) meaning something that is presented which is ready to be used. Which of course leads to why I use the method name 'readytoUseInstance'.

I Use UDT of Properties and State (with variables p and s) to separate extenal properties from internal state.

Within methods I prefix variables with the prefix 'my'.

For method parameters i use the prefixed ip, op and iop for input only, output only, and imput that is mutated and output.

A side benefit of these prefixes p,s,my,ip,op,iop is that they also remove some the majority of the issues encountered when trying to name variables/parameters.