Class module structure, get same property on different levels - excel

I'm trying to build a class module with my whole Company as follows:
Now I know how to achieve this thanks to this answer.
The thing is I am on a planning area which will schedule everyone's work and shifts, so I need to add both Dates and timetable... I want to build a timetable for the whole day dividied by every single minute, so 1440 minutes.
If I were to write the 2 classes with the properties I need such as Auxiliar Time and Workers on the shift, could I call them from any other class without messing with each other?
My goal is to be able to for example sum the Aux time given a day, a group of minutes depending on the department, or the department in a specific location.
I understand this is going to be tedious to write, but is it possible to achieve such a thing?
My code right now calls the Agent which will have different properties, such as his location, service, name and area. By giving his ID you can fill these and if you feed the class a Date, you can get his schedule, department and a comment.
I understand this would have to change, all of it, but I just need to know if is possible what I'm trying to accomplish here, or is there any way more efficient than my initial structure.
My code goes as follows:
Company Class:
Option Explicit
Private ID As Object
Property Get clAgente(ByVal Key As String) As clAgente
With ID
If Not .Exists(Key) Then .Add Key, New clAgente
End With
Set clAgente = ID(Key)
End Property
Public Property Get Count() As Long
Count = ID.Count
End Property
Public Property Get Keys() As Variant
Keys = ID.Keys
End Property
Private Sub Class_Initialize()
Set ID = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set ID = Nothing
End Sub
Agent Class:
Option Explicit
Private Centro As String
Private Servicio As String
Private Nombre As String
Private DirNeg As String
Private Agrup As String
Private Fechas As Object
Property Get Business() As String
Business = DirNeg
End Property
Property Let Business(ByVal param As String)
DirNeg = param
End Property
Property Get Group() As String
Group = Agrup
End Property
Property Let Group(ByVal param As String)
Agrup = param
End Property
Property Get Location() As String
Location = Centro
End Property
Property Let Location(ByVal param As String)
Centro = param
End Property
Property Get Service() As String
Service = Servicio
End Property
Property Let Service(ByVal param As String)
Servicio = param
End Property
Property Get Name() As String
Name = Nombre
End Property
Property Let Name(ByVal param As String)
Nombre = param
End Property
Property Get clHorarios(ByVal Key As Date) As clHorarios
With Fechas
If Not .Exists(Key) Then .Add Key, New clHorarios
End With
Set clHorarios = Fechas(Key)
End Property
Private Sub Class_Initialize()
Set Fechas = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set Fechas = Nothing
End Sub
Public Property Get Count() As Long
Count = Fechas.Count
End Property
Public Property Get Keys() As Variant
Keys = Fechas.Keys
End Property
And finally,
Date class:
Option Explicit
Private m_Horario As String
Private m_Modo As String
Private m_Coment As String
'Aquí creamos la propiedad Horario para la clase Fecha
Public Property Get Horario() As String
Horario = m_Horario
End Property
Public Property Let Horario(ByVal param As String)
m_Horario = param
End Property
'Aquí creamos la propiedad Modo para la clase Fecha
Public Property Get Modo() As String
Modo = m_Modo
End Property
Public Property Let Modo(ByVal param As String)
m_Modo = param
End Property
'Aquí creamos la propiedad Coment para la clase Fecha
Public Property Get Comentario() As String
Comentario = m_Coment
End Property
Public Property Let Comentario(ByVal param As String)
m_Coment = param
End Property
Any insight on the matter would be greatly appreciated.

In a word: Yes
[...] could I call them from any other class without messing with each
other?
Keep in mind that the class is just the structure and meaningless until instantiated and assigned to an object variable that can be copied and modified by any line of code within scope. So, whether or not any class has access to that variable is dependent on scope and whether or not you end up with a mess depends on you and our design.
[...] is it possible to achieve such a thing?
If you did not already know that it is possible to do this thing, then you will have a significant amount of learning to do before you can do this thing.
Any insight on the matter would be greatly appreciated.
Nothing you haven't heard before and you're not already doing: read, try, and learn.

Related

Managing Collections inside a Class

i'm trying to work with classes in vba and i haven't found any documentation related to managing objects inside objects such as arrays or collections inside a class.
Let's say i have a class person and a class address and i want to manage addresses of a person.
Address
Private pStreet as String
Private pZip as Int
Public Property Let Street(val As String)
pStreet = val
End Property
Public Property Get Street() As String
Street = pStreet
End Property
Public Property Let Zip(val As String)
pZip = val
End Property
Public Property Get Zip() As String
Zip = pZip
End Property
Person
Private pName As String
Private pSurname As String
Private pAddresses As Collection
Public Property Let Name(val As String)
pName = val
End Property
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Surname(val As String)
pSurname = val
End Property
Public Property Get Surname() As String
Surame = pSurname
End Property
Private Sub Class_Initialize()
Set pAddresses = New Collection
End Sub
Private Sub Class_Terminate()
Set pAddresses = Nothing
End Sub
Public Sub addAddress(ByVal val As Address)
pAddresses.Add val
End Sub
Public Property Get Addresses() As Collection
Set Addresses = pAddresses
End Property
Public Property Get Address(ByVal Index As Long) As Address
Set Address = pAddresses(Index)
End Property
Module1
Sub test()
Dim x As Person
Set x = New Person
Dim a1 As Address
Set a1 = New Address
Dim a2 As Address
Set a2 = New Address
x.Name = "Mark"
x.Surname = "Doe"
a1.Street = "first avenue 213"
a1.Zip = "41242"
a2.Street = "second avenue 213"
a2.Zip = "55242"
x.addAddress a1
x.addAddress a2
Debug.Print x.Address(0)
End Sub
how should i deal with the address collection inside the person class?
for instance, how could i retrieve all the addresses or the second address of the collection? x.addresses(1) doesn't work.
The Person class should hold a collection of addresses, to avoid having to expand and preserve an array. The collection should be initialized/terminated as soon as the class is initialized/terminated.
See an example:
Private pAddresses as Collection
Private Sub Class_Initialize()
Set pAddresses = New Collection
End Sub
Private Sub Class_Terminate()
Set pAddresses = Nothing
End Sub
The class can expose the whole address collection via a property for looping, or a single address accessed by index.
Public Property Get Addresses() As Collection
Set Addresses = pAddresses
End property
Public Property Get Address(ByVal Index As Long) As Address
Set Address = pAddresses(Index)
End property
Then you can loop:
Dim p As Person, a As Address
For Each a In p.Addresses
a.Zip = ...
Next
Or get a single address by index:
Set a = p.Addresses(1)
Lastly, a simple Add method, to add an address to the person:
Public Sub AddAddress(ByVal param As Address)
pAddresses.Add param
End Sub
You could also add (or replace) an address using a property by supplying both the address object and the index, but I dont know how useful it is in your case. Of course you need to make sure Index is valid.
Public Property Let Address(ByVal Index As Long, ByVal param As Address)
pAddresses.Add param, Index
End property
Then to call it:
p.Addresses(Index) = a
To enforce the Set keyword, since we're dealing with objects, change Let to Set. Then, you need to set-it:
Set p.Addresses(Index) = a

Excel vba - class constructor method not working, debug error

i have this class and i am trying to make a class constructor or factory method (not sure how's the right name in VBA). When i try to run it i get a dialog with written debug error, and ig highlights the set row of the test module. What's wrong? What is the right way to instantiate the collection in the constructor? is it better to use the keyword this when using let/get ?
Class Address
Private pStreet As String
Private pZip As Integer
Public Property Let Street(val As String)
pStreet = val
End Property
Public Property Get Street() As String
Street = pStreet
End Property
Public Property Let Zip(val As Integer)
pZip = val
End Property
Public Property Get Zip() As Integer
Zip = pZip
End Property
Class Person
Private pName As String
Private pSurname As String
Private pAddresses As New Collection
Public Property Let Name(val As String)
pName = val
End Property
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Surname(val As String)
pSurname = val
End Property
Public Property Get Surname() As String
Surame = pSurname
End Property
Private Sub Class_Initialize()
Set pAddresses = New Collection
End Sub
Private Sub Class_Terminate()
Set pAddresses = Nothing
End Sub
Public Sub addAddress(ByVal val As Address)
pAddresses.Add val
End Sub
Public Property Get Addresses() As Collection
Set Addresses = pAddresses
End Property
Public Property Get Address(ByVal Index As Long) As Address
Set Address = pAddresses(Index)
End Property
Public Function CreatePerson(ByVal Name As String, ByVal Surname As String) As Person
With New Person
.pName = Name
.pSurname = Surname
Set CreatePerson = .Self
instance
End With
End Function
test Module
sub test()
Dim x as Person
Set x = Person.CreatePerson("Mike","Jordan")
end sub
Another option for creating a factory method is to use another class:
PersonFactory Class
Option Explicit
Public Function Create(ByVal Name As String, ByVal Surname As String, ByVal Street As String, ByVal Zip As Integer) As Person
Dim a As Address
Set Create = New Person
Create.Name = Name
Create.Surname = Surname
Set a = New Address
a.Street = Street
a.Zip = Zip
Create.Addresses.Add a
End Function
Test Module
Private Sub Test()
Dim pf As PersonFactory
Dim p As Person
Set pf = New PersonFactory
Set p = pf.Create("Mike", "Jordan", "my street", 11111)
End Sub
You have several errors
Your anonymous new is for GiantCorp and Not Person
You have no self method to return the Me Instance created by the With New Person
3 No idea what 'instance' is doing.
Your address class does not manage a collection of addresses, nor does you person class
Here is updated code for your person class. Don't feel too bad, Factory classes in VBA are actuall a tricky subject when you first encounter them.
Option Explicit
'#PredecalredId
'#exposed
Private Type Properties
Name As String
Surname As String
Address As Address
End Type
Private p As Properties
Public Property Let Name(ipName As String)
p.Name = ipName
End Property
Public Property Get Name() As String
Name = p.Name
End Property
Public Property Let Surname(ipSurname As String)
p.Surname = ipSurname
End Property
Public Property Get Surname() As String
Surame = p.Surname
End Property
' This property will fail as the Address class is not a collection
Public Sub addAddress(ipAddress As Address)
Set p.Address = ipAddress
End Sub
Public Function CreatePerson(ByVal ipName As String, ByVal ipSurname As String) As Person
With New Person 'GiantComp no idea what this GiantComp' class is doing here
' Private fields cannot be accessed here, you need to forward them to the self function
'.pName = ipName
'.pSurname = ipSurname
Set CreatePerson = .Self(ipName, ipSurname)
End With
End Function
Public Function Self(ByVal ipName As String, ByVal ipSurname As String) As Person
' You are now inside the anonymous Person class you created with 'With nEw Person' so you can now access private fields
p.Name = ipName
p.Surname = ipSurname
Set Self = Me
End Function
You will also need to set the PredeclaredId attribute. This involves either exporting you class, editing the relevant attribute and reimporting, or, much more conveniently, using the attribute annotation '#PredecaredId provided by the free and fantastic Rubberduck add in for VBA.
Good luck in creating an addresses collection class to manage you addresses. Lots of examples are available of how to wrap a collection to produce a collection class.

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

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.

Access a a nested class from inside another nested class

I have one main class with 3 nested classes looking like this:
Main class:
Option Explicit
Private m_Login As Object
Private m_Archivo As Object
Private m_Equivalencia As Object
Private Property Get Logins(ByVal Key As String) As Logins
With m_Login
If Not .Exists(Key) Then .Add Key, New Logins
End With
Set Logins = m_Login(Key)
End Property
Private Sub Class_Initialize()
Set m_Login = CreateObject("Scripting.Dictionary")
Set m_Archivo = CreateObject("Scripting.Dictionary")
Set m_Equivalencia = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set m_Login = Nothing
Set m_Archivo = Nothing
Set m_Equivalencia = Nothing
End Sub
Private Property Get Keys() As Variant
Keys = m_Login.Keys
End Property
Private Property Get Count() As Long
Count = m_Login.Count
End Property
Private Property Get Items() As Variant
Items = m_Archivo.Keys
End Property
Public Property Get Archivos(ByVal Key As String) As Archivos
With m_Archivo
If Not .Exists(Key) Then .Add Key, New Archivos
End With
Set Archivos = m_Archivo(Key)
End Property
Public Property Get Equivalencias(ByVal Key As String) As Equivalencias
With m_Equivalencia
If Not .Exists(Key) Then .Add Key, New Equivalencias
End With
Set Equivalencias = m_Equivalencia(Key)
End Property
The three nested classes are, as you can see, Logins, Archivos and Equivalencias.
Now I'm trying to get the data stored in Equivalencias class from inside the Logins class.
When doing it from the main class I just need to write Equivalencias(id).Property for example, but I can't seem to call it from inside the nested class Logins.
How would I do it?
I need to do so because inside the Logins class I have this:
Public Property Get ModificacionCentro() As Boolean
If Not Baja And Not Alta Then
Select Case m_Site
Case "GLORIAS" And m_Centro <> "Barcelona Glorias (AESP) (GRAN VÍA DE LAS CORTS CATALANES 866-872, BARCELONA)"
ModificacionCentro = True
Case "ILUSTRACIÓN" And m_Centro <> "Madrid Ilustración (AESP) (C/SANTIAGO DE COMPOSTELA, 94, MADRID)"
ModificacionCentro = True
Case "TÁNGER" And m_Centro <> "MARRUECOS TANGER SUCURSAL (AESP) (RUE IBN FOURMAT ANGLE CARNOT, TANGER 90000 (MAROC))"
ModificacionCentro = True
Case Else
ModificacionCentro = False
End Select
End If
End Property
Right now I'm doing it hardcoded, but If I could access the other class I wouldn't need to, The code would be:
Public Property Get ModificacionCentro() As Boolean
If Not Baja And Not Alta Then
If Not Equivalencias(m_Site) = m_Centro Then ModificacionCentro = False
End If
End Property
And I wouldn't need to hardcode everytime it the sites would change.

Creating Class properties with sub levels

I've been reading this topic on how to use class modules.
My goal is to improve my code performance and readability so I think I'm in the right path.
But I have some questions about the limitations.
In my head i want to do this:
Is it possible to achieve such a structure?
The topic I've read has very few examples and this is not handled. I'm assuming this would be possible with collections of collections, but I not sure how to look for this.
My data comes from 2 tables, one has all the items but the department and the other one has the ID's alongisde the departments. Both tables have the dates of the current month as headers and their Schedule/Department depending on the table.
I'd know how to achieve this for one day, but not for a whole month.
This is how I wrote the basics for my class:
Option Explicit
Private DirNeg As String
Private Agrup As String
Private DNI As String
Private Centro As String
Private Servicio As String
Private Nombre As String
Property Get Business() As String
Business = DirNeg
End Property
Property Let Business(ByVal sBusiness As String)
DirNeg = sBusiness
End Property
Property Get Group() As String
Group = Agrup
End Property
Property Let Group(ByVal sGroup As String)
Agrup = sGroup
End Property
Property Get ID() As String
ID = DNI
End Property
Property Let ID(ByVal sID As String)
DNI = sID
End Property
Property Get Location() As String
Location = Centro
End Property
Property Let Location(ByVal sLocation As String)
Centro = sLocation
End Property
Property Get Service() As String
Service = Servicio
End Property
Property Let Service(ByVal sService As String)
Servicio = sService
End Property
Property Get Name() As String
Name = Nombre
End Property
Property Let Name(ByVal sName As String)
Nombre = sName
End Property
On the other hand, is it correct to fill the whole class on the Class_Initializeevent? My data will always be the same so I don't need to loop in a normal module to fill the class, it could be done everytime the class is created.
EDIT/UPDATE:
This is how my data looks like:
Schedules alongside Agent's info
Departments alongside Agent's ID
clAgent Class Module:
Option Explicit
Private DirNeg As String
Private Agrup As String
Private DNI As String
Private Centro As String
Private Servicio As String
Private Nombre As String
Private Fechas As Object
Property Get Business() As String
Business = DirNeg
End Property
Property Let Business(ByVal sBusiness As String)
DirNeg = sBusiness
End Property
Property Get Group() As String
Group = Agrup
End Property
Property Let Group(ByVal sGroup As String)
Agrup = sGroup
End Property
Property Get ID() As String
ID = DNI
End Property
Property Let ID(ByVal sID As String)
DNI = sID
End Property
Property Get Location() As String
Location = Centro
End Property
Property Let Location(ByVal sLocation As String)
Centro = sLocation
End Property
Property Get Service() As String
Service = Servicio
End Property
Property Let Service(ByVal sService As String)
Servicio = sService
End Property
Property Get Name() As String
Name = Nombre
End Property
Property Let Name(ByVal sName As String)
Nombre = sName
End Property
Property Get clFechas(ByVal StringKey As String) As clFechas
With Fechas
If Not .Exists(StringKey) Then
Dim objFechas As New clFechas
.Add StringKey, objFechas
End If
End With
End Property
Private Sub Class_Initialize()
Set Fechas = CreateObject("Scripting.Dictionary")
End Sub
clFechas Class Module:
Option Explicit
Private Modos As Object
Private Horarios As Object
'Aqiço creamos la propiedad Modo para la clase Fecha
Public Property Get Modo(ByVal StringKey As String) As String
Modo = Modos(StringKey)
End Property
Public Property Let Modo(ByVal StringKey As String, ByVal StringValue As String)
Modos(StringKey) = StringValue
End Property
Public Property Get Keys() As Variant
Keys = Modos.Keys
End Property
'Aquí creamos la propiedad Horario para la clase Fecha
Public Property Get Horario(ByVal StringKey As String) As String
Modo = Horarios(StringKey)
End Property
Public Property Let Horario(ByVal StringKey As String, ByVal StringValue As String)
Horarios(StringKey) = StringValue
End Property
Public Property Get Keys() As Variant
Keys = Horarios.Keys
End Property
'Iniciamos la clase
Private Sub Class_Initialize()
Set Modos = CreateObject("Scripting.Dictionary")
Set Horarios = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set Modos = Nothing
Set Horarios = Nothing
End Sub
You don’t seem to have any issues with regular properties so let’s focus on the complex ones; Schedule and Department. Both are the same, so same rules apply to both.
The property is basically list, the date is the index and the item is an object. I personally prefer to work with dictionaries as I can look if a key exist etc.
So, your Agent class could look something like this:
Option Explicit
Private m_schedules As Object
Public Property Get Schedule(ByVal Key As Date) As Schedules
With m_schedules
If Not .Exists(Key) Then .Add Key, New Schedules
End With
Set Schedule = m_schedules(Key)
End Property
'For testing purposes - can be ommited.
Public Property Get Keys() As Variant
Keys = m_schedules.Keys
End Property
'For testing purposes - can be ommited.
Public Property Get Count() As Long
Count = m_schedules.Count
End Property
Private Sub Class_Initialize()
Set m_schedules = CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set m_schedules = Nothing
End Sub
The Schedules class:
Option Explicit
Private m_schedule As String
Public Property Get Schedule() As String
Schedule = m_schedule
End Property
Public Property Let Schedule(ByVal param As String)
m_schedule = param
End Property
Now, let's test it:
Sub Test()
Dim obj As Agent
Set obj = New Agent
obj.Schedule(#1/9/2019#).Schedule = "Schedule 1"
obj.Schedule(#2/9/2019#).Schedule = "Schedule 2"
obj.Schedule(#3/9/2019#).Schedule = "Schedule 3"
PrintToDebug obj
'Lets make a change
obj.Schedule(#2/9/2019#).Schedule = "Schedule 2222"
PrintToDebug obj
End Sub
Private Sub PrintToDebug(ByVal obj As Agent)
Debug.Print ""
Dim m As Variant
With obj
For Each m In .Keys
Debug.Print "Key: " & m & String(3, " ") & "Value: " & .Schedule(m).Schedule
Next m
End With
Debug.Print "Total Items: " & obj.Count
End Sub
Output:
'Key: 09/01/2019 Value: Schedule 1
'Key: 09/02/2019 Value: Schedule 2
'Key: 09/03/2019 Value: Schedule 3
'Total Items: 3
'Key: 09/01/2019 Value: Schedule 1
'Key: 09/02/2019 Value: Schedule 2222
'Key: 09/03/2019 Value: Schedule 3
'Total Items: 3
Additional information regarding the Dictionary object can be found here: Dictionary object
Also keep this in mind. It's quite important:
If key is not found when changing an item, a new key is created with
the specified newitem. If key is not found when attempting to return
an existing item, a new key is created and its corresponding item is
left empty.
If the dictionary item is not a simple string, let me know to update the answer. Sorry, I couldnt read the data in the screenshots. :)

Resources