I'm pretty new to this, so I'm sorry if I screw up any of the lingo. Thanks a bunch for anybody's help or thoughts.
I have the following wrong code:
Sub ExampleSub(text As String)
ClassObject." & text & "_attribute = 1
End Sub
So if I call ExampleSub("cheese"), I would like it to set ClassObject.cheese_attribute equal to 1.
Any thoughts? I'm not even sure it's possible.
Thanks so much!
Here is another method that might work. Use a scripting dictionary object as one of the classobject's Properties. The Dictionary Object is pretty neat, storing elements in key/value pairs, where the key is a string and the value can be any other type (object, range, Workbook, integer, variant/array, etc.)
So you can use the dictionary object to contain all of these named attributes. In your class module, add code like:
Private pAttributes as Object
Sub Class_Initialize()
'## Initialize this object to avoid a 91 error
Set pAttributes = CreateObject("Scripting.Dictionary")
End Sub
Public Property Get Attributes() As Object
Set Attributes = pAttributes
End Property
Public Property Let Attributes(lAttributes As Object)
Set pAttributes = lAttributes
End Property
Then, in your code you can simply do:
Sub ExampleSub(text As String)
ClassObject.Attributes(text) = 1
End Sub
Calling a dictionary key automatically adds the item if it doesn't already exist, but if you wanted more control you could do:
Sub AnotherExample(text as String)
If ClassObject.Attributes.Exists(text) Then
MsgBox text & " already exists!", vbInformation
Else:
ClassObject.Attributes(text) = 1
End If
End Sub
Related
Is there anyway that I can put various classes into an array so that instead of hard-coding like:
set var1 = new cls1
set var2 = new cls2
we can do:
varArr = array ( var1, var2...)
clsArr = array (cls1, cls2...)
and now I just loop thru varArr and clsArr to set new class accordingly, like:
sub setNew(x as double)
set varArr(x) = new clsArr(x)
end sub
I did try but it didn't work, please help me out
Thank you very much !
Triet (mr)
I try, but my knowledge also limited.
First of all I do not think you can put class into an array. You can put objects. I also failed to use the array() function.
Please see how I proceeded with some demonstration:
This is the class module, containing a value, the property and a primitive print sub:
Private nr As Integer 'Use as identification
Sub cPrint()
MsgBox "Object ID: " & nr
End Sub
Property Let ID(v As Integer)
nr = v
End Property
In the module in the first cycle I create the object, put the ID value. In the second one all ID values are printed. I hope you can use it for your purposes.
Sub clsTest()
Dim varArr(1 To 5) As cls1
Dim i As Integer
For i = 1 To 5
Set varArr(i) = New cls1
varArr(i).ID = i
Next
For i = 1 To 5
varArr(i).cPrint
Next
End Sub
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.
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
I have two questions.
I would like to add a new object type (not sure which) in a new sub to an existing collection which is made in underlying sub. So in an other sub I would like to add psecs.pNom to this collection (securities).
I would like to add more rows (secId) to this existing collection (securities). Again in an other sub.
How to do this?
Thanks, Amir
Sub testclass()
rijaantal_LenDump = Application.CountA(Sheets("Len_Dump").Range("A:A"))
kolomaantal_LenDump = Application.CountA(Sheets("Len_Dump").Range("1:1"))
Sheets("Len_Dump").Select
positions = Sheets("Len_Dump").Range(Cells(1, 1), Cells(rijaantal_LenDump, kolomaantal_LenDump))
kolomSecID = 8
Set securities = New Collection
For i = 1 To rijaantal_LenDump
Set psecs = New CMpos
psecs.secId = CStr(positions(i, 8))
psecs.L4 = CStr(positions(i, 4))
If Not Exists(securities, psecs.secId) Then securities.Add psecs, psecs.secId
Next i
Debug.Print securities.Count
End Sub
Pass the collection ByRef to the other procedure.
Public Sub AddAnotherObject(ByRef colSecurities As Collection)
Dim objOther As SomeOtherObject
Set objOther = New SomeOtherObject
colSecurities.Add objOther, CStr(objOther.ID)
End Sub
When you get back to the calling procedure, the collection's count will be one higher and the object will be in the collection. The opposite of ByRef is ByVal. Changes to a variable passed ByVal are lost once the procedure ends.