I have a class "Currency" and a class "Currencies" which is a collection of instances of "Currency" class objects. I think this resembles Excel's Worksheet class which is a member of the Sheets collection. I can address any member by index or "Key", like Sheets(1) or `Sheets("Sheet1").
Here is code from my "Currencies" class module. It's abbreviated for use here and may not run, which is not the issue.
Private Sub Class_Initialize()
' Class "Currencies"
Dim R As Long
Set AllCcys = New Collection
Arr = .Range("Currencies").Value
For R = 1 To UBound(Arr)
Set Ccy = Me.Add(Arr(R, 1))
Next R
End Sub
Public Function Add(ByVal Key As String) As cCcy
Dim Fun As cCcy
Set Fun = New cCcy
AllCcys.Add Fun, Key
Fun.Key = Key
Set Add = Fun
End Function
Public Property Get Item(Key As Variant) As cCcy
Set Item = AllCcys(Key)
End Property
With my setup I can access any of the "Currency" objects with syntax like Currencies.Item("USD").Rate or Currencies.Item(1).Rate which I consider convoluted. I would like to use Currencies("USD").Rate analog to what I do when accessing Excel's Sheets collection.
How can I achieve that?
According to http://www.cpearson.com/excel/DefaultMember.aspx, you can specify any procedure in a custom class to be the default member by the steps below:
Export Currencies class module
Open the exported module in Notepad
Add Attribute Value.VB_UserMemId = 0 in your Item property like this:
Public Property Get Item(Key As Variant) As cCcy
Attribute Value.VB_UserMemId = 0
Set Item = AllCcys(Key)
End Property
Save and Import back into your file.
Note: You can only have 1 procedure be the default member and you will not see the line Attribute Value.VB_UserMemId = 0 in the VBE.
Related
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'm programming quite a complex thing in VBA I think and even though I did a lot of research I couldn't come up with a solution to my problem so far. And unfortunately I'm no expert :)
I have two classes, e.g. clsBuilding and clsFactory, which both have an instance of clsHeatDemand. Now I'm trying to implement a parent-Property to access some values from the base classes I need for the calculation, based on this idea.
Friend Property Get Parent() As clsBuilding
Set Parent = ObjFromPtr(parentPtr)
End Property
Friend Property Set Parent(obj As clsBuilding)
parentPtr = ObjPtr(obj)
End Property
My problem now is that the parent can be of two different types even though they have the same parameters I need. So what I'm trying to ask is if there is a way to hand over the instances simply as obj As Object and still access its properties?
I also tried this with Interfaces but I would be happy if there is another easier solution.
I don't know if this can help you, have a look at it.
' Class which has different parent
Option Explicit
Private m_parent As Variant
Public Property Get Parent() As Variant
Set Parent = m_parent
End Property
Public Property Set Parent(ByVal vNewValue As Variant)
Set m_parent = vNewValue
End Property
Public Function Name()
If TypeName(m_parent) = "ParentA" Then
Name = m_parent.Name
Else
Err.Raise 123, "Parent doesn't have Name"
End If
End Function
Public Function Height()
If TypeName(m_parent) = "ParentB" Then
Height = m_parent.Height
Else
Err.Raise 456, "Parent doesn't have Height"
End If
End Function
' ParentA
Public Name As String
Public Age As Integer
' ParentB
Public Height As Double
Public Weight As Double
' Test
Sub test()
Dim c As Class
Set c = New Class
Dim pa As ParentA
Set pa = New ParentA
pa.Age = 5
pa.Name = "Parent A"
Dim pb As ParentB
Set pb = New ParentB
pb.Height = 15.5
pb.Weight = 50.5
Set c.Parent = pa
Debug.Print c.Name
Set c.Parent = pb
Debug.Print c.Height
Debug.Print c.Name
End Sub
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
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
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