Techniques for binding object properties to Sheet Cells - excel

Edit:
The three main things I'm looking to accomplish here are:
To be able to encapsulate properties/methods into a class (easy enough)
Use excel ranges as a user input for users to manipulate class property values.
(bonus) Send user changes back up to a database.
I've been playing with the idea of building something in vba that would allow me to bind an object's property(ies) to a Range. Basically turning a cell into a bound control.
Some basic requirements I might be after include:
A change to the object property would update the cell value
A change to the cell would update the object property
The object property may be bound/unbound without losing the value of the property.
My initial thought is to build a BindRange class that simply gets its value from a range and sets its value to that range.
BindRange.cls:
Option Explicit
Private p_BoundCell As Range
Public Property Get Value() As String
If Me.IsBound Then Value = p_BoundCell.Value
End Property
Public Property Let Value(Val As String)
If Me.IsBound Then p_BoundCell.Value = Val
End Property
Public Property Get IsBound() As Boolean
If BoundToDeletedCell Then
Set p_BoundCell = Nothing
End If
IsBound = Not (p_BoundCell Is Nothing)
End Property
Public Sub Bind(Cell As Range)
Set p_BoundCell = Cell(1, 1)
End Sub
Private Function BoundToDeletedCell() As Boolean
Dim sTestAddress As String
On Error Resume Next
TRY:
If p_BoundCell Is Nothing Then
Exit Function
'// returns false
End If
sTestAddress = p_BoundCell.Address
If Err.Number = 424 Then 'object required
BoundToDeletedCell = True
End If
End Function
Then, I can set up my custom object with a pair of fields to manage the updates. I would also need a method to expose setting the range to be bound.
TestObject.cls:
Option Explicit
Private p_BindId As BindRange
Private p_Id As String
Public Property Get Id() As String
If p_BindId.IsBound Then
p_Id = p_BindId.Value
End If
Id = p_Id
End Property
Public Property Let Id(Val As String)
p_Id = Val
If p_BindId.IsBound Then
p_BindId.Value = p_Id
End If
End Property
Public Sub Id_Bind(Cell As Range)
p_BindId.Bind Cell
End Sub
Private Sub Class_Initialize()
Set p_BindId = New BindRange
End Sub
Private Sub Class_Terminate()
Set p_BindId = Nothing
End Sub
This could be annoying because any property I want to make "Bindable" I'll have to manage Get/Set and Bind for each. I'm also not too sure if this will cause any memory issues: making class-properties with variant typed values....
Also considering building a service-like class that keeps track of objects and their bound ranges in a dictionary-like structure?
Anyways, just curious if anyone has done something like this before or if you have any thoughts on how you might design this.

Binding individual cells to properties would be very cumbersome. I think a better technique would be to create a table to act as a property sheet and a PropertySheetWatcher that raise a PropertyChange event.
Let's say for instance that we wanted to create a simple game on a userform call Stack OverKill. Our game will have its Hero Class and multiple Enemies classes (e.g. Turtle, Rhino, Wolf). Although each class has its own business logic they all share common properties (Name, HP, ClassName, Left, Right ...etc). Naturally, since they all sure the same basic set of properties they should all Implement a common Interface (e.g. CharacterInterface). The beauty of this is they can all share the same Property Sheet Table.
Mock Property Sheet Table
PropertySheetWatcher:Class
Private WithEvents ws As Worksheet
Public Table As ListObject
Public Event PropertyChange(ByVal PropertyName As String, Value As Variant)
Public Sub Init(ByRef PropertySheetTable As ListObject)
Set ws = PropertySheetTable.Parent
Set Table = PropertySheetTable
End Sub
Private Sub ws_Change(ByVal Target As Range)
Dim PropertyName As String
If Not Intersect(Target, Table.DataBodyRange) Then
PropertyName = Intersect(Target.EntireColumn, Table.HeaderRowRange).Value
RaiseEvent PropertyChange(PropertyName, Target.Value)
End If
End Sub
Public Sub UpdateProperty(ByVal PropertyName As String, Name As String, Value As Variant)
Application.EnableEvents = False
Dim RowIndex As Long
RowIndex = Table.ListColumns("Name").DataBodyRange.Find(Name).Row
Table.ListColumns(PropertyName).DataBodyRange.Cells(RowIndex).Value = Value
Application.EnableEvents = True
End Sub
Hero:Class
Implements CharacterInterface
Private Type Members
Name As String
HP As Single
ClassName As String
Left As Single
Right As Single
Top As Single
Bottom As Single
Direction As Long
Speed As Single
End Type
Private m As Members
Public WithEvents Watcher As PropertySheetWatcher
Private Sub Watcher_PropertyChange(ByVal PropertyName As String, Value As Variant)
Select Case PropertyName
Case "Speed"
Speed = Value
Case "HP"
'....More Code
End Select
End Sub
Public Property Get Speed() As Single
Speed = m.Speed
End Property
Public Property Let Speed(ByVal Value As Single)
m.Speed = Speed
Watcher.UpdateProperty "Speed", m.Name, Value
End Property
Private Property Get CharacterInterface_Speed() As Single
CharacterInterface_Speed = Speed
End Property
Private Property Let CharacterInterface_Speed(ByVal Value As Single)
Speed = Value
End Property
The classes above give are a quick muck-up of how the notification system can be implemented. But wait there is more!!!
Look how easy it is to setup a Factory to reproduce all of out Characters based off the saved setting.
CharacterFactory:Class
Function AddCharacters(Watcher As PropertySheetWatcher) As CharacterInterface
Dim Table As ListObject
Dim data As Variant
Dim RowIndex As Long
With Table
data = .DataBodyRange.Value
For RowIndex = 1 To UBound(data)
Select Case data(RowIndex, .ListColumns("Class").Index)
Case "Hero"
Set AddCharacters = AddCharacter(New Hero, Table, RowIndex)
Case "Turtle"
Set AddCharacters = AddCharacter(New Turtle, Table, RowIndex)
Case "Rhino"
Set AddCharacters = AddCharacter(New Rhino, Table, RowIndex)
Case "Wolf"
Set AddCharacters = AddCharacter(New Wolf, Table, RowIndex)
End Select
Next
End With
End Function
Private Function AddCharacter(Character As CharacterInterface, Table As ListObject, RowIndex As Long) As Object
With Character
.Speed = Table.ListColumns("Speed").DataBodyRange.Cells(RowIndex).Value
'....More Coe
End With
Set AddCharacter = Character
End Function
It may seem like I wrote a lot of original content but I didn't. The whole setup is an adaptation of concepts taken from different popular design patterns.

Related

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.

VBA - Trying to understand how to call Class Modules

I'm learning VBA through Google, YouTube, etc.. and I came across Class Modules.
I have a Tracker Template.
Every few days I get a report sent to me ("Ice cream FG Inv.xlsm")
While trying to understand Class Modules, I found a template that created a Class Module (within the Tracker Template) WBIceCreamFGINVxlsm creating a CodeName for all of the worksheets within the Ice Cream FG Inv.xlsm Workbook.
Example:
Public Property Get wsinventory() As Worksheet
Set wsinventory = Workbook.Worksheets("Inventory")
End Property
In my module, I want to reference wsinventory, but not understanding exactly how to 'call' the Class Module..
Both Workbooks are Open.
I tried to start with:
Dim Data As Variant
Data = wsinventory.Range("A1").CurrentRegion.Value (**Variable not Defined**)
Then I tried:
Dim wsinventory As Worksheets
With wsinventory
Dim Data As Variant
Data = .Range("A1").CurrentRegion.Value (**Object variable or With variable not set**)
End With
Do I still need to use:
Dim DataSource As Workbook
Set DataSource = Workbooks("Ice Cream FG Inv.xlsm")
With DataSource.Worksheets("Inventory")
End With
If so, what would be the reasoning for using Class Modules?
You need to create a class object before you can access the properties of that class.
Assuming you have this Class and naming it TestClass:
Private pwsinventory As Worksheet
Public Sub init()
Set pwsinventory = Worksheets("Inventory")
End Sub
Public Property Set wsinventory(lwsinventory As Worksheet)
Set pwsinventory = lwsinventory
End Property
Public Property Get wsinventory() As Worksheet
Set wsinventory = pwsinventory
End Property
You can set / get the properties like so:
Sub test()
Dim datacls As TestClass
Dim data As Worksheet
Set datacls = New TestClass
Set datacls.wsinventory = Worksheets("inventory")
Set data = datacls.wsinventory
Debug.Print data.Name
End Sub
This, however, is kind of weird and when you have a property you don't want to set (you need to pass an argument) you should use an initiate function. Unfortunately there is no way I know of to do this without manually calling that sub after the class object is created.
Sub Test2()
Dim datacls As TestClass
Set datacls = New TestClass
datacls.init
Debug.Print datacls.wsinventory.Name
End Sub
The most common case I use classes for is better containers. Generally storing many of the same class type inside an array / dictionary so it is clear what I'm calling, especially if I need to modify the data in the same manner for each instance.
I am going to give another example. Create a class definition and name it ArrayData, and define multiple initialization subroutines
ArrayData.cls
Private m_data() As Variant
Private Sub Class_Initialize()
End Sub
Public Sub IntializeEmpty(ByVal rows As Long, ByVal columns As Long)
ReDim m_data(1 To count, 1 To columns)
End Sub
Public Sub InitializeFromRange(ByRef target As Range)
If target.rows.count > 1 Or target.columns.count > 1 Then
m_data = target.Value2
Else
ReDim m_data(1 To 1, 1 To 1)
m_data(1, 1) = target.Value
End If
End Sub
Public Sub InitializeFromArray(ByRef data() As Variant)
m_data = data
End Sub
Public Property Get RowCount() As Long
RowCount = UBound(m_data, 1) - LBound(m_data, 1) + 1
End Property
Public Property Get ColCount() As Long
ColCount = UBound(m_data, 2) - LBound(m_data, 2) + 1
End Property
Public Property Get Item(ByVal row As Long, ByVal col As Long) As Variant
Item = m_data(row, col)
End Property
Public Property Let Item(ByVal row As Long, ByVal col As Long, ByVal x As Variant)
m_data(row, col) = x
End Property
Module
To test the code in a code module initialize the class with the New keyword and then call one of the custom initialization subroutines.
Public Sub TestArray()
Dim arr As New ArrayData
arr.InitializeFromRange Sheet1.Range("A2").Resize(10, 1)
Dim i As Long
For i = 1 To arr.RowCount
Debug.Print arr.Item(i, 1)
Next i
End Sub
PS. Also read this article on how to designate one property as the default. In the example above if Item was the default property then you could write code such as
Debug.Print arr(5,2)
instead of
Debug.Pring arr.Item(5,2)

Properly coding a constructor

I am trying to implement a Model-View-Presenter Userinterface in VBA excel. In order to do this I have been writing different Model classes. Here an Example:
Option Explicit
Private Type TModel
FilterCol As Collection
N As Integer
End Type
Private this As TModel
Public Property Get FilterCol() As Collection
Set FilterCol = this.FilterCol
End Property
Public Property Let FilterCol(ByVal value As Collection)
Set this.FilterCol = value
End Property
Public Property Get N() As Integer
Set N = this.N
End Property
Public Property Let N(ByVal value As Integer)
Set this.N = value
End Property
This class called "FilterModel" is a collection of MSFormObjects. In order to use the collection properly I need to new it. So the code where I use it would look a little like this:
Sub testFilter()
Dim Filterm As FilterModel
Dim DefaultFilterLine As New FilterLine
Set Filterm = New FilterModel
Filterm.FilterCol = New Collection
'Set DefaultFilter
Filterm.FilterCol.Add DefaultFilterLine
'DoStuff
With New frmFilter
Set .Model = Filterm
.Show
End With
End Sub
If I don't new the Property FilterCol before I add something, in this case the defaultfilter, it doesn't work. So here is my Question:
Is there a way to overwrite the new statement for my new class in order to have it also new up the collection FilterCol. My research got me as far as I now know that this would be called a constructor.
But how would one properly implement a constructor for a VBA class?
Somthing like:
Private Sub Class_Initialize()
Set this.FilterCol = New Collection
N = 0
End Sub
If I do this then I get an error in the "Property Let N(Byval Value as integer)" Line. The error message reads "object required".
Here is a working solution. I suggest going through the code line-by-line using F8 to understand what is happening there. Debug.print prints values into the Immediate window.
Here is the FilterModel class:
''' FilterModel class
Option Explicit
Private pFilterCol As Collection
Private pN As Integer
Public Property Get FilterCol() As Collection
Set FilterCol = pFilterCol
End Property
Public Property Let FilterCol(ByVal value As Collection)
Set pFilterCol = value
End Property
Public Property Get N() As Integer
N = pN
End Property
Public Property Let N(ByVal value As Integer)
pN = value
End Property
Private Sub Class_Initialize()
Set pFilterCol = New Collection
pN = 0
End Sub
and here is module code to test it:
''' random module
Option Explicit
Sub testFilter()
Dim Filterm As FilterModel
Set Filterm = New FilterModel
Filterm.FilterCol = New Collection
''' default values (specified in Class_Initialize())
Debug.Print Filterm.N
Debug.Print Filterm.FilterCol.Count
''' set the values through Property Let
Filterm.FilterCol.Add "whatever"
Filterm.FilterCol.Add "whenever"
Filterm.N = 6
''' print the new values (through Property Get)
Debug.Print Filterm.N
Debug.Print Filterm.FilterCol.Count
Debug.Print Filterm.FilterCol(1)
Debug.Print Filterm.FilterCol(2)
End Sub

Object Properties at Runtime

I want to write to custom class properties dynamically. In my use case, I have a table with column headers. The headers are properties of an Issue class. There are over 120 columns per issue. The end user chooses which columns they want included in the report. How do I set the properties of an object when the columns are not known until runtime? I couldn't find anything on Google that helped.
EDITED for clarity
Here is a snippet of my CIssue class:
Option Explicit
Private pIncidentNumber As String
Private pIncidentType As String
Private pContent As String
Private pStartDate As Date
Private pEndDate As Date
Public Property Let IncidentNumber(Value As String)
pIncidentNumber = Value
End Property
Public Property Get IncidentNumber() As String
IncidentNumber = pIncidentNumber
End Property
Public Property Let IncidentType(Value As String)
pIncidentType = Value
End Property
Public Property Get IncidentType() As String
IncidentType = pIncidentType
End Property
Public Property Let Content(Value As String)
pContent = Value
End Property
Public Property Get Content() As String
Content = pContent
End Property
Public Property Let StartDate(Value As Date)
pStartDate = Value
End Property
Public Property Get StartDate() As Date
StartDate = pStartDate
End Property
Public Property Let EndDate(Value As Date)
pEndDate = Value
End Property
Public Property Get EndDate() As Date
EndDate = pEndDate
End Property
It does nothing but help organize my code. I will build a collection class for this, also. If the end user chooses Incident Number and Content columns I want to set the appropriate properties. There could be up to 1,000 rows of data. So I need to set the properties for the rows that fit the criteria.
Example
I might have 72 rows that fit the criteria. Therefore, I need to add to my collection 72 objects of type CIssue with the correct properties set according to the columns the end user chose.
Thanks!
The core problem:
Create only properties in CIssue objects that are selected according to a listview.
For this first issue, I created a Sheet ("Sheet1") to which I added an ActiveX ListView (MicroSoft ListView Control, version 6.0) that I populated with the Column headers (or property names) as follows in a regular module:
Option Explicit
Sub PopulateListView()
Dim i As Integer
i = 1
With Worksheets("Sheet1")
.TestListView.ListItems.Clear
Do While Not IsEmpty(.Cells(1, i))
.TestListView.ListItems.Add i, , .Cells(1, i).Value
i = i + 1
Loop
End With
End Sub
I set the following properties:
Checkboxes to True
MultiSelect to True
This will allow us to loop over selected items and create properties in our CIssue class accordingly.
Next, I added a reference to MicroSoft Scripting Runtime, so the Dictionary class is available. This is needed, because with the Collection class there's no easy way to retrieve the "property" by "key" (or property name, as below).
I created the CIssue class as follows:
Option Explicit
Private p_Properties As Dictionary
Private Sub Class_Initialize()
Set p_Properties = New Dictionary
End Sub
Public Sub AddProperty(propertyname As String, value As Variant)
p_Properties.Add propertyname, value
End Sub
Public Function GetProperty(propertyname As Variant) As Variant
On Error Resume Next
GetProperty = p_Properties.Item(propertyname)
On Error GoTo 0
If IsEmpty(GetProperty) Then
GetProperty = False
End If
End Function
Public Property Get Properties() As Dictionary
Set Properties = p_Properties 'Return the entire collection of properties
End Property
This way, you can do the following in a regular module:
Option Explicit
Public Issue As CIssue
Public Issues As Collection
Public lv As ListView
Sub TestCreateIssues()
Dim i As Integer
Dim Item As ListItem
Set lv = Worksheets("Sheet1").TestListView
Set Issues = New Collection
For i = 2 To 10 'Or however many rows you filtered, for example those 72.
Set Issue = New CIssue
For Each Item In lv.ListItems 'Loop over ListItems
If Item.Checked = True Then ' If the property is selected
Issue.AddProperty Item.Text, Worksheets("Sheet1").Cells(i, Item.Index).value 'Get the property name and value, and add it.
End If
Next Item
Issues.Add Issue
Next i
End Sub
Thereby ending up with a Collection of CIssue objects, that only have the required properties populated. You can retrieve each property by using CIssue.GetProperty( propertyname ). It will return "False" if the property doesn't exist, otherwise the value of the property. Since it returns Variant it will cater for Dates, Strings, etc.
Note that if you want to loop over filtered rows, you can amend the loop above accordingly. Note that the propertyname parameter for the GetProperty method is also a Variant - This allows you to pass in strings as well as the actual Key objects.
To populate another sheet, with whatever you captured this way, you can do something like the following (in either the same or a different module; note that the Sub above needs to be run first, otherwise your Collection of CIssues will not exist.
Sub TestWriteIssues()
Dim i As Integer
Dim j As Integer
Dim Item As ListItem
Dim p As Variant
Dim k As Variant
i = 1
j = 0
'To write all the properties from all issues:
For Each Issue In Issues
i = i + 1
For Each p In Issue.Properties.Items
j = j + 1
Worksheets("Sheet2").Cells(i, j).value = p
Next p
j = 0
Next Issue
'And add the column headers:
i = 0
For Each k In Issues.Item(1).Properties.Keys
i = i + 1
Worksheets("Sheet2").Cells(1, i).value = k
'And to access the single property in one of the Issue objects:
MsgBox Issues.Item(1).GetProperty(k)
Next k
End Sub
Hope this is more or less what you were after.
N.b. more background on why the choice for Dictionary instead of Collection in this question

Do I need an array, class, dictionary, or collection?

I am not sure what the best option is for what I'm trying to do. Currently, I'm using a 3D array to hold these values, but I am just now learning about dictionaries, classes, and collections in VBA and can't determine if any of those would be better or more useful for what I'm trying to do.
I get a new spreadsheet of data every month, and I need to loop through cells looking for a number, and replace another cell's data based on that number. I.E. (all in Col. A)
4323
4233
4123
4343
4356
3213
In column B, I need to put a corresponding country. If the first two digits are 43, the cell to the right should be "Germany" and then in col. C, "DEU". If the two numbers are 41, then the col. B cell should be "USA", and in C, "USA"...etc. etc.
Currently, I'm setting up a 3D array (psuedo code):
myArray(0,0) = 43
myArray(0,1) = "Germany"
myArray(0,2) = "DEU"
myArray(1,0) = 41
myArray(1,1) = "United States"
myArray(1,2) = "USA"
etc. etc.
Then, I have a loop going through all the cells and replacing the information.
Would a class perhaps be better? I could then do something like create a cntry. Code, cntry.Country, cntry.CountryAbbrev and use those to refer to "43", "Germany", and "DEU"
(again, psuedo code):
num = left("A1",2)
'then here, somehow find the num in cntry.Code list - will need to work out how
Cells("B1").Value = cntry.Country
Cells("C1").Value = cntry.CountryAbbrev
...
As for Dictionaries, I think that won't work, as (AFAIK) you can only have one key per entry. So I could do the country number ("43") but set only either the Country name or Country Abbreviation - but not both....correct?
Does this question make sense? Is using a class/dictionary overkill on something like this? Would a collection be best?
Thanks for any advice/guidance!
Class Module is the answer. It's always the answer. Code is code and there's almost nothing you can do in a class module that you can't do in a standard module. Classes are just a way to organize your code differently.
But the next question becomes how to store your data inside your class module. I use Collections out of habit, but Collection or Scripting.Dictionary are your best choices.
I'd make a class called CCountry that looks like this
Private mlCountryID As Long
Private msCode As String
Private msFullname As String
Private msAbbreviation As String
Public Property Let CountryID(ByVal lCountryID As Long): mlCountryID = lCountryID: End Property
Public Property Get CountryID() As Long: CountryID = mlCountryID: End Property
Public Property Let Code(ByVal sCode As String): msCode = sCode: End Property
Public Property Get Code() As String: Code = msCode: End Property
Public Property Let Fullname(ByVal sFullname As String): msFullname = sFullname: End Property
Public Property Get Fullname() As String: Fullname = msFullname: End Property
Public Property Let Abbreviation(ByVal sAbbreviation As String): msAbbreviation = sAbbreviation: End Property
Public Property Get Abbreviation() As String: Abbreviation = msAbbreviation: End Property
Then I'd make a class called CCountries to hold all of my CCountry instances
Private mcolCountries As Collection
Private Sub Class_Initialize()
Set mcolCountries = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolCountries = Nothing
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mcolCountries.[_NewEnum]
End Property
Public Sub Add(clsCountry As CCountry)
If clsCountry.CountryID = 0 Then
clsCountry.CountryID = Me.Count + 1
End If
mcolCountries.Add clsCountry, CStr(clsCountry.CountryID)
End Sub
Public Property Get Country(vItem As Variant) As CCountry
Set Country = mcolCountries.Item(vItem)
End Property
Public Property Get Count() As Long
Count = mcolCountries.Count
End Property
You see that CCountries is merely a Collection at this point. You can read more about that NewEnum property at http://dailydoseofexcel.com/archives/2010/07/09/creating-a-parent-class/
Then I'd put all my country stuff in a Table and read that table into my class. In CCountries
Public Sub FillFromRange(rRng As Range)
Dim vaValues As Variant
Dim i As Long
Dim clsCountry As CCountry
vaValues = rRng.Value
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
Set clsCountry = New CCountry
With clsCountry
.Code = vaValues(i, 1)
.Fullname = vaValues(i, 2)
.Abbreviation = vaValues(i, 3)
End With
Me.Add clsCountry
Next i
End Sub
I'd need a way to find a country by one of its properties
Public Property Get CountryBy(ByVal sProperty As String, ByVal vValue As Variant) As CCountry
Dim clsReturn As CCountry
Dim clsCountry As CCountry
For Each clsCountry In Me
If CallByName(clsCountry, sProperty, VbGet) = vValue Then
Set clsReturn = clsCountry
Exit For
End If
Next clsCountry
Set CountryBy = clsReturn
End Property
Then I'd run down my list of numbers and put the codes next to them
Sub FillCodes()
Dim clsCountries As CCountries
Dim rCell As Range
Dim clsCountry As CCountry
Set clsCountries = New CCountries
clsCountries.FillFromRange Sheet1.ListObjects("tblCountries").DataBodyRange
For Each rCell In Sheet2.Range("A3:A5").Cells
Set clsCountry = Nothing
Set clsCountry = clsCountries.CountryBy("Code", CStr(rCell.Value))
If Not clsCountry Is Nothing Then
rCell.Offset(0, 1).Value = clsCountry.Fullname
rCell.Offset(0, 2).Value = clsCountry.Abbreviation
End If
Next rCell
End Sub
Other than defining where the codes I'm looping through are, I don't really need any comments. You can tell what's going on my the name of the object and the properties or methods. That's the payoff for the extra work in setting up class modules - IMO.
You can have a dictionary of objects or dictionaries.
VBA has several methods to store data:
a Dictionary
a Collection
an array (matrix) variable
an ActiveX ComboBox
an ActiveX ListBox
a Userform control ComboBox
a Userform control ListBox
a sortedlist
an arraylist
I suggest you to read the following article:
http://www.snb-vba.eu/VBA_Dictionary_en.html

Resources