Using Classes with nested arrays

Question

I'd like to use classes instead of structures in my VBA program, but could not figure it out. Below is an example of what I'm doing, and would be grateful for any advice. Maybe classes are not good for this type of thing, because it did not seem very intuitive to me, I don't know.

Option Explicit
Public Type xYear
    month(1 To 12) As Double ' Index is the month
End Type
Public Type Company
    Name As String
    City As String
    Sales(2010 To 2020) As xYear ' Index is the year
End Type
Public SuperData(1 To 50) As Company ' An array of companies with monthly sales 
Sub Test_Table()
    Dim Company1_Name As String
    Dim Company1_City As String
    Dim Company1_2011_Sales(1 To 12) As Double
    Dim Company1_2012_Sales(1 To 12) As Double
    Dim Toledo_Sales_Jul_2012 As Double
    ' Test Data
    Company1_Name = "ABC"
    Company1_City = "Toledo"
    Company1_2011_Sales(7) = 1000
    Company1_2012_Sales(7) = 2000
    ' Copy test data into Structure
    SuperData(1).Name = Company1_Name
    SuperData(1).City = Company1_City
    SuperData(1).Sales(2011).month(7) = Company1_2011_Sales(1) ' Jul 2011 sales
    SuperData(1).Sales(2012).month(7) = Company1_2012_Sales(7) ' Jul 2012 sales
    ' Query the structure
    Toledo_Sales_Jul_2012 = City_Sales("Toledo", 7, 2012)
End Sub
Public Function City_Sales(ByRef City As String, ByRef m As Double, ByRef y As Double) As Double
        Dim c As Double
        For c = LBound(SuperData) To UBound(SuperData)
        If City = SuperData(c).City Then
            City_Sales = City_Sales + SuperData(c).Sales(y).month(m)
        End If
    Next
End Function

Answer 1

I would do this with four classes: CCompany and CSale and collection classes for both.

CCompany:

Private mlCompanyID As Long
Private msCompanyName As String
Private msCity As String
Private mclsSales As CSales
Private mlParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (dest As Any, Source As Any, ByVal bytes As Long)


Public Property Set Sales(ByVal clsSales As CSales): Set mclsSales = clsSales: End Property
Public Property Get Sales() As CSales: Set Sales = mclsSales: End Property
Public Property Let CompanyID(ByVal lCompanyID As Long): mlCompanyID = lCompanyID: End Property
Public Property Get CompanyID() As Long: CompanyID = mlCompanyID: End Property
Public Property Let CompanyName(ByVal sCompanyName As String): msCompanyName = sCompanyName: End Property
Public Property Get CompanyName() As String: CompanyName = msCompanyName: End Property
Public Property Let City(ByVal sCity As String): msCity = sCity: End Property
Public Property Get City() As String: City = msCity: End Property
Public Property Get Parent() As CCompanies: Set Parent = ObjFromPtr(mlParentPtr): End Property
Public Property Set Parent(obj As CCompanies): mlParentPtr = ObjPtr(obj): End Property

Private Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj As Object
    CopyMemory obj, pObj, 4
    Set ObjFromPtr = obj
    ' manually destroy the temporary object variable
    ' (if you omit this step you'll get a GPF!)
    CopyMemory obj, 0&, 4
End Function

Private Sub Class_Initialize()
    Set mclsSales = New CSales
End Sub

Private Sub Class_Terminate()
    Set mclsSales = Nothing
End Sub

CCompanies:

Private mcolCompanies As Collection

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

Private Sub Class_Terminate()
    Set mcolCompanies = Nothing
End Sub

Public Property Get NewEnum() As IUnknown
    Set NewEnum = mcolCompanies.[_NewEnum]
End Property

Public Sub Add(clsCompany As CCompany)
    If clsCompany.CompanyID = 0 Then
        clsCompany.CompanyID = Me.Count + 1
    End If

    Set clsCompany.Parent = Me
    mcolCompanies.Add clsCompany, CStr(clsCompany.CompanyID)
End Sub

Public Property Get Company(vItem As Variant) As CCompany
    Set Company = mcolCompanies.Item(vItem)
End Property

Public Property Get Count() As Long
    Count = mcolCompanies.Count
End Property

CSale:

Private mlSaleID As Long
Private mdAmount As Double
Private mlYear As Long
Private mlMonth As Long
Private mlParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (dest As Any, Source As Any, ByVal bytes As Long)


Public Property Let SaleID(ByVal lSaleID As Long): mlSaleID = lSaleID: End Property
Public Property Get SaleID() As Long: SaleID = mlSaleID: End Property
Public Property Let Amount(ByVal dAmount As Double): mdAmount = dAmount: End Property
Public Property Get Amount() As Double: Amount = mdAmount: End Property
Public Property Let Year(ByVal lYear As Long): mlYear = lYear: End Property
Public Property Get Year() As Long: Year = mlYear: End Property
Public Property Let Month(ByVal lMonth As Long): mlMonth = lMonth: End Property
Public Property Get Month() As Long: Month = mlMonth: End Property
Public Property Get Parent() As CSales: Set Parent = ObjFromPtr(mlParentPtr): End Property
Public Property Set Parent(obj As CSales): mlParentPtr = ObjPtr(obj): End Property

Private Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj As Object
    CopyMemory obj, pObj, 4
    Set ObjFromPtr = obj
    ' manually destroy the temporary object variable
    ' (if you omit this step you'll get a GPF!)
    CopyMemory obj, 0&, 4
End Function

CSales:

Private mcolSales As Collection

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

Private Sub Class_Terminate()
    Set mcolSales = Nothing
End Sub

Public Property Get NewEnum() As IUnknown
    Set NewEnum = mcolSales.[_NewEnum]
End Property

Public Sub Add(clsSale As CSale)
    If clsSale.SaleID = 0 Then
        clsSale.SaleID = Me.Count + 1
    End If

    Set clsSale.Parent = Me
    mcolSales.Add clsSale, CStr(clsSale.SaleID)
End Sub

Public Property Get Sale(vItem As Variant) As CSale
    Set Sale = mcolSales.Item(vItem)
End Property

Public Property Get Count() As Long
    Count = mcolSales.Count
End Property


Public Sub AddSale(ByVal dAmount As Double, ByVal lYear As Long, ByVal lMonth As Long)

    Dim clsSale As CSale

    Set clsSale = New CSale
    With clsSale
        .Amount = dAmount
        .Year = lYear
        .Month = lMonth
    End With

    Me.Add clsSale

End Sub

Then in a standard module.

Sub Test_Class()

    Dim clsCompanies As CCompanies
    Dim clsCompany As CCompany
    Dim clsSale As CSale

    Set clsCompanies = New CCompanies

    Set clsCompany = New CCompany
    clsCompany.CompanyName = "ABC"
    clsCompany.City = "Toledo"

    'Verbose way to add a sale
    Set clsSale = New CSale
    clsSale.Amount = 1000
    clsSale.Year = 2011
    clsSale.Month = 7
    clsCompany.Sales.Add clsSale

    'Quickway to add a sale
    clsCompany.Sales.AddSale 2000, 2012, 7

    clsCompanies.Add clsCompany

    For Each clsCompany In clsCompanies
        For Each clsSale In clsCompany.Sales
            Debug.Print clsCompany.CompanyName, clsCompany.City, clsSale.Amount, clsSale.Year, clsSale.Month
        Next clsSale
    Next clsCompany

End Sub

This uses some undocumented features, such as to be able to use For Each on a custom class. Here are a couple of references for you.

http://dailydoseofexcel.com/archives/2010/07/09/creating-a-parent-class/

http://www.cpearson.com/excel/classes.aspx