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.
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
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.
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.
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.
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.
I currently have 3 separate variants that are all arrays consisting of 13 rows and 1 column. One variant represents names, another represents changes and the last represents occurrences. Please see my starter code below:
Sub watchList()
Dim names As Variant
names = Sheets("Watch Calculations").Range("B4:B16")
Dim changes As Variant
changes = Sheets("Watch Calculations").Range("G4:G16")
Dim occurances As Variant
occurrences = Sheets("Watch Calculations").Range("G22:G34")
End Sub
I also have a class called counterParty with the following fields:
Public Name As String
Public changeStatus As String
Public negativeOccurences As Integer
How can I loop through all 3 variants at the same time and input the values into an object of the counterParty class based on the row number of each variant. Please see psuedo code below:
Dim i As Integer
Dim MyArray(1 To 13) As Integer
For i = 1 To UBound(MyArray)
'psuedo code stars here
create new object of class counterParty
set object.Name = names(i,1)
set object.changeStatus = changes(i,1)
set object.negativeOccurences= occurrences.get(i,1)
add object to array of counterParty objects
Next i
Try this out
First the class module:
Private pName As String
Private pchangeStatus As String
Private pnegativeOccurrences As Long
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(lName As String)
pName = lName
End Property
Public Property Get changeStatus() As String
changeStatus = pchangeStatus
End Property
Public Property Let changeStatus(lchangeStatus As String)
pchangeStatus = lchangeStatus
End Property
Public Property Get negativeOccurrences() As Long
negativeOccurrences = pnegativeOccurrences
End Property
Public Property Let negativeOccurrences(lnegativeOccurrences As Long)
pnegativeOccurrences = lnegativeOccurrences
End Property
Then the module:
Dim names As Variant
names = Sheets("Watch Calculations").Range("B4:B16")
Dim changes As Variant
changes = Sheets("Watch Calculations").Range("G4:G16")
Dim occurrences As Variant
occurrences = Sheets("Watch Calculations").Range("G22:G34")
Dim i As Long
Dim clsarr(1 To 13) As Object 'You can use lbound and ubound on names() to get dynamic values
Dim mycls As Class1
For i = 1 To UBound(names)
Set mycls = New Class1 'Overwrite current object
'assign values to the class properties
mycls.Name = names(i, 1)
mycls.changeStatus = changes(i, 1)
mycls.negativeOccurrences = occurrences(i, 1)
Set clsarr(i) = mycls
Next i
I am trying to loop over the items in a dictionary with an object variable that refer to inheritance class "Breed", but I am unable to do so with dictionaries but with collections it is pretty simple is there a way to solve this without using the dictionary's keys? because then I will lose the ability to use the intelisense feature.
Here is the code of the class Breed:
Option Explicit
Public Property Get Name() As String
End Property
Public Property Get Color() As String
End Property
Public Property Get Price() As Double
End Property
Here is the code for class Dogs:
Option Explicit
Implements Breed
Private pName As String, pPrice As Double, pColor As String
Public Property Let Name(Val As String)
pName = Val
End Property
Public Property Get Name() As String
Name = pName
End Property
Private Property Get Breed_Name() As String
Breed_Name = Name
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Let Price(Val As Double)
pPrice = Val
End Property
Public Property Get Price() As Double
Price = pPrice
End Property
Private Property Get Breed_Price() As Double
Breed_Price = Price
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Let Color(Val As String)
pColor = Val
End Property
Public Property Get Color() As String
Color = pColor
End Property
Private Property Get Breed_Color() As String
Breed_Color = Color
End Property
Here is the code for class Cats:
Option Explicit
Implements Breed
Private pName As String, pPrice As Double, pColor As String
Public Property Let Name(Val As String)
pName = Val
End Property
Public Property Get Name() As String
Name = pName
End Property
Private Property Get Breed_Name() As String
Breed_Name = Name
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Let Price(Val As Double)
pPrice = Val
End Property
Public Property Get Price() As Double
Price = pPrice
End Property
Private Property Get Breed_Price() As Double
Breed_Price = Price
End Property
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Let Color(Val As String)
pColor = Val
End Property
Public Property Get Color() As String
Color = pColor
End Property
Private Property Get Breed_Color() As String
Breed_Color = Color
End Property
Here is the code for the regular module with collection but fails with dictionary:
Option Explicit
Sub Main()
Dim C As Cats
Dim D As Dogs
Dim Coll As Collection
Dim B As Breed
Set C = New Cats
C.Name = "Catomon"
C.Color = "Angle White"
C.Price = 800.98
Set D = New Dogs
D.Name = "Dogomon"
D.Color = "Golden White"
D.Price = 1000.23
Set Coll = New Collection
Coll.Add C
Coll.Add D
Set B = New Breed
For Each B In Coll
Debug.Print B.Name, B.Color, B.Price
Next B
Set C = Nothing
Set D = Nothing
Set B = Nothing
Set Coll = Nothing
End Sub
Dictionary methods .Keys() and .Items() return arrays. Only way to iterate over arrays is with an variable of type Variant. With these restrictions, the only way I can think of is casting Variant variable to the type Breed inside the loop. This way, after the casting, you get Intellisense.
Based on the code you posted, an example would be:
Sub MainWithDictionary()
Dim C As Cats
Dim D As Dogs
Dim Dict As Scripting.Dictionary
Dim B As Breed
Dim K As Variant 'new variable
Set C = New Cats
C.Name = "Catomon"
C.Color = "Angle White"
C.Price = 800.98
Set D = New Dogs
D.Name = "Dogomon"
D.Color = "Golden White"
D.Price = 1000.23
Set Dict = New Scripting.Dictionary
'Keys are just placeholders
Dict.Add 1, C
Dict.Add 2, D
For Each K In Dict.Items()
'Cast the Variant result to Breed
Set B = K
'You will have Intellisense on each dictionary items after this
Debug.Print B.Name, B.Color, B.Price
Next K
Set C = Nothing
Set D = Nothing
Set B = Nothing
Set Dict = Nothing
End Sub
I'm trying to create a class module that takes two arguments, inputted by user, and then make a calculation to create a private property that returns a calculated value
Here is what I got so far:
'clsItem Class Module
Option Explicit
Private mQt As Integer
Private mPrice As Double
Private mTotal As Double
Public Property Let Quantity(Value As Integer)
mQt = Value
End Property
Public Property Let Price(Value As Double)
mPrice = Value
End Property
Private Function SetTotal(mQt As Integer, mVl As Double)
mTotal = mQt * mPrice
End Function
Public Property Get Quantity() As Integer
Quantity = mQt
End Property
Public Property Get Price() As Double
Price = mPrice
End Property
Public Property Get Total() As Double
SetTotal mQt, mPrice 'This smells
Total = mTotal
End Property
The part where I've commented This smells is a kludge I put on so the code below gives the expected behavior:
'Object Module
Sub TestCls()
Dim basicItem As clsItem
Set basicItem = New clsItem
With basicItem
.Quantity = 100
.Price = 12.5
End With
Debug.Print basicItem.Total
End Sub
I think this is wrong because
I'm using a get property to call a function, but I've couldn't figure a way to place this calling anywhere else on the code.
If I don't call clsItem.Total somewhere in the module mTotal will never update.
I've tried using Class_Initialize() but it gives 0 since the .Quantity and .Price are not passed to the class yet.
So how can I make this right?
Remove the SetTotal
Just calculate the total in your Get Total()
So you end up with
'clsItem Class Module
Option Explicit
Private mQt As Integer
Private mPrice As Double
Public Property Let Quantity(Value As Integer)
mQt = Value
End Property
Public Property Get Quantity() As Integer
Quantity = mQt
End Property
Public Property Let Price(Value As Double)
mPrice = Value
End Property
Public Property Get Price() As Double
Price = mPrice
End Property
Public Property Get Total() As Double
Total = mQt * mPrice
End Property
I'm trying to create a class to hold a variable number of items (which are themselves another class object).
So, I have Class 2:
' Class 2 contain each individual quote elements (OTC and MRC)
Private pOTC As String
Private pMRC As String
Public Property Get OTC() As String
OTC = pOTC
End Property
Public Property Let OTC(Value As String)
pOTC = Value
End Property
Public Property Get MRC() As String
MRC = pMRC
End Property
Public Property Let MRC(Value As String)
pMRC = Value
End Property
Then Class 1 contains an array of Class 2:
Private pCurr As String
Private pQuote(20) As Class2
Public Property Get Curr() As String
Curr = pCurr
End Property
Public Property Let Curr(Value As String)
pCurr = Value
End Property
Public Property Set Quote(Index As Integer, cQuote As Class2)
Set pQuote(Index) = cQuote
End Property
Public Property Get Quote(Index As Integer) As Class2
Quote = pQuote(Index)
End Property
And what I would like to do is something like:
Dim myQuotes As Class1
Set myQuotes = New Class1
myQuotes.Curr = "GBP"
myQuotes.Quote(3).OTC = "1200"
The first line setting myQuotes.Curr is no problem, however when I try to set a value inside the array the next line errors with Run-time 91 Object variable or With block variable not set
Any pointers as to what I'm doing wrong and how can I set the values for the elements within the class array?
Thanks in advance!
When you myQuotes.Quote(3) you call Property Get Quote which has an issue.
Your internal array of Class2 is not instantiated so pQuote(Index) refers to an array element of Nothing, when you then myQuotes.Quote(3).OTC = you try to assign to Nothing which fails.
You need to make sure pQuote(Index) is instanced; you can do this on demand:
Public Property Get Quote(Index As Integer) As Class2
If (pQuote(Index) Is Nothing) Then Set pQuote(Index) = New Class2
Set Quote = pQuote(Index)
End Property
(Note the required Set)
Or by adding an intitialisation routine to Class1:
Private Sub Class_Initialize()
Dim Index As Long
For Index = 0 To UBound(pQuote)
Set pQuote(Index) = New Class2
Next
End Sub
You need to set them as New Class2 in Class1:
For intI = LBOUND(pQuote) to UBOUND(pQuote)
Set pQuote(intI) = New Class2
Next IntI
Just as you do with Class1 in your final script.
Maybe it should be
Public Property Let Quote(Index As Integer, cQuote As Class2)
Set pQuote(Index) = cQuote
End Property