I have an Excel VBA project that makes heavy use of Windows Scripting Dictionary objects. I recently had a user attempt to use it on a Mac and received the following error:
Compile Error: Can't find project or library
Which is the result of using the Tools > References > Microsoft Scripting Runtime library.
My question is, is there a way to make this work on a Mac?
The following are the 3 cases I can think of as being possible solutions:
Use a Mac plugin that enables use of Dictionaries on Macs (my favorite option if one exists)
Do some kind of variable switch like the following:
isMac = CheckIfMac
If isMac Then
' Change dictionary variable to some other data type that is Mac friendly and provides the same functionality
End If
Write 2 completely separate routines to do the same thing (please let this not be what needs to happen):
isMac = CheckIfMac
If isMac Then
DoTheMacRoutine
Else
DoTheWindowsRoutine
End If
Pulling the Answer from the comments to prevent link rot.
Patrick O'Beirne # sysmod wrote a class set that addresses this issue.
Be sure to stop by Patirk's Blog to say thanks! Also there is a chance he has a newer version.
save this as a plain text file named KeyValuePair.cls and import into Excel
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "KeyValuePair"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Unrestricted class just to hold pairs of values together and permit Dictionary object updating
Public Key As String
Public value As Variant
save this as a plain text file named Dictionary.cls and import into excel
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Dictionary"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Collection methods: Add, Count, Item, Remove
'Dictionary : .Add(Key as string, Item as variant), .CompareMode, .Count, .Exists(Key); _
.Item(Key) - writeable, .Items, .Keys, .Remove(Key), .RemoveAll
'plus KeyValuePairs collection, KeyValuePair(Index as long), Tag as variant
' 25-11-2011 KeyValuePair helper object
Public KeyValuePairs As Collection ' open access but allows iteration
Public Tag As Variant ' read/write unrestricted
Private Sub Class_Initialize()
Set KeyValuePairs = New Collection
End Sub
Private Sub Class_Terminate()
Set KeyValuePairs = Nothing
End Sub
' in Scripting.Dictionary this is writeable, here we have only vbtextCompare because we are using a Collection
Public Property Get CompareMode() As VbCompareMethod
CompareMode = vbTextCompare '=1; vbBinaryCompare=0
End Property
Public Property Let Item(Key As String, Item As Variant) ' dic.Item(Key) = value ' update a scalar value for an existing key
Let KeyValuePairs.Item(Key).value = Item
End Property
Public Property Set Item(Key As String, Item As Variant) ' Set dic.Item(Key) = value ' update an object value for an existing key
Set KeyValuePairs.Item(Key).value = Item
End Property
Public Property Get Item(Key As String) As Variant
AssignVariable Item, KeyValuePairs.Item(Key).value
End Property
' Collection parameter order is Add(Item,Key); Dictionary is Add(Key,Item) so always used named arguments
Public Sub Add(Key As String, Item As Variant)
Dim oKVP As KeyValuePair
Set oKVP = New KeyValuePair
oKVP.Key = Key
If IsObject(Item) Then
Set oKVP.value = Item
Else
Let oKVP.value = Item
End If
KeyValuePairs.Add Item:=oKVP, Key:=Key
End Sub
Public Property Get Exists(Key As String) As Boolean
On Error Resume Next
Exists = TypeName(KeyValuePairs.Item(Key)) > "" ' we can have blank key, empty item
End Property
Public Sub Remove(Key As String)
'show error if not there rather than On Error Resume Next
KeyValuePairs.Remove Key
End Sub
Public Sub RemoveAll()
Set KeyValuePairs = Nothing
Set KeyValuePairs = New Collection
End Sub
Public Property Get Count() As Long
Count = KeyValuePairs.Count
End Property
Public Property Get Items() As Variant ' for compatibility with Scripting.Dictionary
Dim vlist As Variant, i As Long
If Me.Count > 0 Then
ReDim vlist(0 To Me.Count - 1) ' to get a 0-based array same as scripting.dictionary
For i = LBound(vlist) To UBound(vlist)
AssignVariable vlist(i), KeyValuePairs.Item(1 + i).value ' could be scalar or array or object
Next i
Items = vlist
End If
End Property
Public Property Get Keys() As String()
Dim vlist() As String, i As Long
If Me.Count > 0 Then
ReDim vlist(0 To Me.Count - 1)
For i = LBound(vlist) To UBound(vlist)
vlist(i) = KeyValuePairs.Item(1 + i).Key '
Next i
Keys = vlist
End If
End Property
Public Property Get KeyValuePair(Index As Long) As Variant ' returns KeyValuePair object
Set KeyValuePair = KeyValuePairs.Item(1 + Index) ' collections are 1-based
End Property
Private Sub AssignVariable(variable As Variant, value As Variant)
If IsObject(value) Then
Set variable = value
Else
Let variable = value
End If
End Sub
Public Sub DebugPrint()
Dim lItem As Long, lIndex As Long, vItem As Variant, oKVP As KeyValuePair
lItem = 0
For Each oKVP In KeyValuePairs
lItem = lItem + 1
Debug.Print lItem; oKVP.Key; " "; TypeName(oKVP.value);
If InStr(1, TypeName(oKVP.value), "()") > 0 Then
vItem = oKVP.value
Debug.Print "("; CStr(LBound(vItem)); " to "; CStr(UBound(vItem)); ")";
For lIndex = LBound(vItem) To UBound(vItem)
Debug.Print " (" & CStr(lIndex) & ")"; TypeName(vItem(lIndex)); "="; vItem(lIndex);
Next
Debug.Print
Else
Debug.Print "="; oKVP.value
End If
Next
End Sub
'NB VBA Collection object index is 1-based, scripting.dictionary items array is 0-based
'cf Scripting.Dictionary Methods s.Add(Key, Item), s.CompareMode, s.Count, s.Exists(Key); _
s.Item(Key) - updateable, s.Items, s.Key(Key), s.Keys, s.Remove(Key), s.RemoveAll
'Scripting.Dictionary has no index number; you can index the 0-based variant array of Items returned
' unlike Collections which can be indexed starting at 1
'Efficient iteration is For Each varPair in thisdic.KeyValuePairs
'Another difference I introduce is that in a scripting.dictionary, the doc says
' If key is not found when changing an item, a new key is created with the specified newitem.
' If key is not found when attempting to return an existing item, a new key is created and its corresponding item is left empty.
'but I want to raise an error when addressing a key that does not exist
'similarly, the scripting.dictionary will create separate integer and string keys for eg 2
Patirk's implementation doesn't work for MS Office 2016 on Mac. I made use of the implementation by Tim Hall.
Here is the link: https://github.com/VBA-tools/VBA-Dictionary
Also import of cls files into Excel doesn't work in MS Office 2016 on Mac as of September 2017. So I had to create a class module and to copy and paste the contents of Dictionary.cls manually in that module while removing meta info from Dictionary.cls such as VERSION 1.0 CLASS, BEGIN, END, Attribute.
I have at last updated the files for Excel 2016 for Mac.
http://www.sysmod.com/Dictionary.zip
(capital D in Dictionary)
Unzip this and import the class files (tested in Excel 2016 for Mac 16.13 Build 424, 27-Apr-2018)
My bug report to MS is at answers.microsoft.com
Excel 16.13 for Mac User Defined Class passed as parameter all properties are Null
Let me know if I've missed anything else!
Good luck,
Patrick O'Beirne
Related
I am currently creating a Class Object for a VBA file, its objective is to act as a range dictionary that can be passed single cells. If this cell is contained in one of the ranges, it returns the value associated to the corresponding range key. The class name is "rangeDic".
It is in the making so its functionalities are not implemented yet. Here's the code:
Private zone() As String
Private bounds() As String
Private link As Dictionary
Const ContextId = 33
'Init zone
Private Sub Class_Initialize()
Set link = New Dictionary
ReDim zone(0)
ReDim bounds(0)
End Sub
'properties
Property Get linkDico() As Dictionary
Set linkDico = link
End Property
Property Set linkDico(d As Dictionary)
Set link = d
End Property
Property Get pZone() As String()
pZone = zone
End Property
Property Let pZone(a() As String)
Let zone = a
End Property
'methods
Public Sub findBounds()
Dim elmt As String
Dim i As Integer
Dim temp() As String
i = 1
For Each elmt In zone
ReDim Preserve bounds(i)
temp = Split(elmt, ":")
bounds(i - 1) = temp(0)
bounds(i) = temp(1)
i = i + 2
Next elmt
End Sub
I was trying to instanciate it in a test sub in order to debug mid conception. Here's the code:
Sub test()
Dim rd As rangeDic
Dim ran() As String
Dim tabs() As Variant
Dim i As Integer
i = 1
With ThisWorkbook.Worksheets("DataRanges")
While .Cells(i, 1).Value <> none
ReDim Preserve ran(i - 1)
ReDim Preserve tabs(i - 1)
ran(i - 1) = .Cells(i, 1).Value
tabs(i - 1) = .Cells(i, 3).Value
i = i + 1
Wend
End With
Set rd = createRangeDic(ran, tabs)
End Sub
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
Dim obje As Object
Dim zonesL As Integer
Dim valsL As Integer
Dim i As Integer
zonesL = UBound(zones) - LBound(zones)
valsL = UBound(vals) - LBound(vals)
If zonesL <> valsL Then
Err.Raise vbObjectError + 5, "", "The key and value arrays are not the same length.", "", ContextId
End If
Set obje = New rangeDic
obje.pZone = zones()
For i = 0 To 5
obje.linkDico.add zones(i), vals(i)
Next i
Set createRangeDic = obje
End Function
Take a look at line 2 of Public Function createRangeDic. I have to declare my object as "Object", if I try declaring it as "rangeDic", Excel crashes at line obje.pZone = zones(). Upon looking in the Windows Event Log, I can see a "Error 1000" type of application unknown error resulting in the crash, with "VB7.DLL" being the faulty package.
Why so ? Am I doing something wrong ?
Thanks for your help
Edit: I work under Excel 2016
It looks like this is a bug. My Excel does not crash but I get an "Internal Error".
Let's clarify a few things first, since you're coming from a Java background.
Arrays can only be passed by reference
In VBA an array can only be passed by reference to another method (unless you wrap it in a Variant). So, this declaration:
Property Let pZone(a() As String) 'Implicit declaration
is the equivalent of this:
Property Let pZone(ByRef a() As String) 'Explicit declaration
and of course, this:
Public Function createRangeDic(zones() As String, vals() As Variant) As rangeDic
is the equivalent of this:
Public Function createRangeDic(ByRef zones() As String, ByRef vals() As Variant) As rangeDic
If you try to declare a method parameter like this: ByVal a() As String you will simply get a compile error.
Arrays are copied when assigned
Assuming two arrays called a and b, when doing something like a = b a copy of the b array is assigned to a. Let's test this. In a standard module drop this code:
Option Explicit
Sub ArrCopy()
Dim a() As String
Dim b() As String
ReDim b(0 To 0)
b(0) = 1
a = b
a(0) = 2
Debug.Print "a(0) = " & a(0)
Debug.Print "b(0) = " & b(0)
End Sub
After running ArrCopy my immediate window looks like this:
As shown, the contents of array b are not affected when changing array a.
A property Let always receives it's parameters ByVal regardless of whether you specify ByRef
Let's test this. Create a class called Class1 and add this code:
Option Explicit
Public Property Let SArray(ByRef arr() As String)
arr(0) = 1
End Property
Public Function SArray2(ByRef arr() As String)
arr(0) = 2
End Function
Now create a standard module and add this code:
Option Explicit
Sub Test()
Dim c As New Class1
Dim arr() As String: ReDim arr(0 To 0)
arr(0) = 0
Debug.Print arr(0) & " - value before passing to Let Property"
c.SArray = arr
Debug.Print arr(0) & " - value after passing to Let Property"
arr(0) = 1
Debug.Print arr(0) & " - value before passing to Function"
c.SArray2 arr
Debug.Print arr(0) & " - value after passing to Function"
End Sub
After running Test, my immediate window looks like this:
So, this simple test proves that the Property Let does a copy of the array even though arrays can only be passed ByRef.
The bug
Your original ran variable (Sub test) is passed ByRef to createRangeDic under a new name zones which is then passed ByRef again to pZone (the Let property). Under normal circumstances there should be no issue with passing an array ByRef as many times as you want but here it seems it is an issue because the Property Let is trying to make a copy.
Interestingly if we replace this (inside createRangeDic):
obje.pZone = zones()
with this:
Dim x() As String
x = zones
obje.pZone = x
the code runs with no issue even if obje is declared As rangeDic. This works because the x array is a copy of the zones array.
It looks that the Property Let cannot make a copy of an array that has been passed ByRef multiple times but it works perfectly fine if it was passed ByRef just once. Maybe because of the way stack frames are added in the call stack, there is a memory access issue but difficult to say. Regardless what the problem is, this seems to be a bug.
Unrelated to the question but I must add a few things:
Using ReDim Preserve in a loop is a bad idea because each time a new memory is allocated for a new (larger) array and each element is copied from the old array to the new array. This is very slow. Instead use a Collection as
#DanielDuĊĦek suggested in the comments or minimize the number of ReDim Preserve calls (for example if you know how many values you will have then just dimension the array once at the beginning).
Reading a Range cell by cell is super slow. Read the whole Range into an array by using the Range.Value or Range.Value2 property (I prefer the latter). Both methods returns an array as long as the range has more than 1 cell.
Never expose a private member object of a class if that object is responsible for the internal workings of the class. For example you should never expose the private collection inside a custom collection class because it breaks encapsulation. In your case the linkDico exposes the internal dictionary which can the be modified from outside the main class instance. Maybe it does not break anything in your particular example but just worth mentioning. On the other hand Property Get pZone() As String() is safe as this returns a copy of the internal array.
Add Option Explicit to the top of all your modules/classes to make sure you enforce proper variable declaration. Your code failed to compile for me because none does not exist in VBA unless you have it somewhere else in your project. There were a few other issues that I found once I turned the option on.
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
First of all I want so say sorry for not showing any code but right now I need some guidelines on how to take out a unique ID of a string.
So I have some problems of how to organize data. Lets say that the data is organized so that each dataID has their unique name. I collect the data into a array that holds it.
The problem I now have is that I want a easy way to search for these nameID. Imagine that the data is a lot bigger and contain more than a few hundred of different unique combinations of nameID's. Therefor I do not think searching for the id itself would be appropriate and I'm thinking of creating an hash that I could use an algorithm on to search the array. I want to do this because later on I will compare the names and add the values to the respective nameID. Keep in mind that the nameID will most of the time have the same structure but eventually a new name like total_air could be implemented and then I need to search in the array to get right value.
Updated:
Example of an code that collect the data from excel:
For Each targetSheet In wb.Worksheets
With targetSheet
'Populate the array
xData(0) = Application.Transpose(Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Value2)
cnt = UBound(xData(0))
End With
Call dData.init(cnt)
'Populate the objectarray
dData.setNameArray = xData(0)
Next targetSheet
Type object:
Private index As Integer
Private id As String
Private nameID() As Variant
Private data() As Variant
Private cnt As Integer
Public Sub init(value As Integer)
index = 0
cnt = value
id = ""
ReDim nameID(0 To cnt)
ReDim data(0 To cnt)
End Sub
Property Let setID(value As String)
id = value
End Property
Property Let setNameArray(value As Variant)
nameID = value
End Property
dList that inherit the dataStruct:
Private xArray() As dataStruct
Private listInd As Integer
Public Sub init(cnt As Integer)
ReDim xArray(1 To cnt)
Dim num As Integer
For num = 1 To cnt
Set xArray(num) = New dataStruct
Next
listInd = 1
End Sub
Property Let addArray(value As dataStruct)
Set xArray(listInd) = value
listInd = listInd + 1
End Property
How the hole list will look like:
I would strongly advocate using a dictionary. Not only is it much faster to find an item (I would assume that it is implemented with some kind of hashing), it has big advantages when it comes to adding or removing items.
When you have an array and want to add an item, you either have always to use redim preserve which is really expensive, or you define the array larger than initially needed and always have to keep the information how many items are really used. And deleting an item from an array is rather complicated.
You cannot add a typed variable as item value into a dictionary, but you can add a object. So instead of your Type definition, create a simple class module, containing only these lines (of course you can create the class with properties, getter and setter but that's irrelevant for this example)
Public id As Long
Public name As String
Public value As Long
Then, dealing with the dictionary is rather simple (note that you have to add a reference to the Microsoft Scripting Runtime
Option Explicit
Dim myList As New Dictionary
Sub AddItemValues(id As Long, name As String, value As Long)
Dim item As New clsMyData
With item
.id = id
.name = name
.value = value
End With
Call AddItem(item)
End Sub
Sub AddItem(item As clsMyData)
If myList.Exists(item.id) Then
set myList(item.id) = item
Else
Call myList.Add(item.id, item)
End If
End Sub
Function SearchItem(id As Long) As clsMyData
If myList.Exists(id) Then
Set SearchItem = myList(id)
Else
Set SearchItem = Nothing
End If
End Function
Function SearchName(name As String) As clsMyData
Dim item As Variant
For Each item In myList.Items
If item.name = name Then
Set SearchName = item
Exit Function
End If
Next item
Set SearchName = Nothing
End Function
So as long as you deal with Id's, the dictionary will do all the work for you. Only if you search for the name, you have to loop over all items of the dictionary, which is as easy as looping over an array.
Some test (of course you should add some error handling)
Sub test()
Call AddItemValues(32, "input_air", 0)
Call AddItemValues(45, "air_Procent", 99)
Call AddItemValues(89, "output_air", 34)
Debug.Print SearchItem(45).name
Debug.Print SearchName("output_air").value
' Change value of output_air
Call AddItemValues(89, "output_air", 1234)
Debug.Print SearchName("output_air").value
End Sub
I'm trying to create a dictionary which has a collection for every key. The reason for this is that I want to retrieve several values from the same key later on. In this example I want to have the total value (val) of a unique key as well as the number of occurrences (n):
sub update()
Dim dict As Dictionary
Dim coll As Collection
Set dict = New Dictionary
Set coll = New Collection
coll.Add 100, "val"
coll.Add 3, "n"
dict.Add "coll", coll
Debug.Print dict.item("coll")("val")
Debug.Print dict.item("coll")("n")
This works fine so far, the problem occurs when I try to update the value in the collection (object doesn't support this):
dict.item("coll")("val") = dict.item("coll")("val") + 100
What I tried:
If I use an array instead of the collection, there is no error but the value doesn't change.
It only works if I read out the collection to variables, change the value, create a new collection, remove the old from the dictionary and add the new collection.
Is there any way to do it like my approach above in a single line?
I would also be happy for an alternative solution to the task.
Once you added an item to the collection, you cannot change it that easily. Such expression:
coll("n") = 5
will cause Run-time error '424': Object required.
You can check it by yourself on the simple example below:
Sub testCol()
Dim col As New VBA.Collection
Call col.Add(1, "a")
col("a") = 2 '<-- this line will cause Run-time error '424'
End Sub
The only way to change the value assigned to the specified key in the given collection is by removing this value and adding another value with the same key.
Below is the simple example how to change the value assigned to a collection with key [a] from 1 to 2:
Sub testCol()
Dim col As New VBA.Collection
With col
Call .Add(1, "a")
Call .Remove("a")
Call .Add(2, "a")
End With
End Sub
Below is your code modified in order to allow you to change the value assigned to the given key in the collection:
Sub update()
Dim dict As Dictionary
Dim coll As Collection
Set dict = New Dictionary
Set coll = New Collection
coll.Add 100, "val"
coll.Add 3, "n"
dict.Add "coll", coll
Debug.Print dict.Item("coll")("val")
Debug.Print dict.Item("coll")("n")
'This works fine so far, the problem occurs when I try to update the value in the collection (object doesn't support this):
Dim newValue As Variant
With dict.Item("coll")
newValue = .Item("val") + 100
On Error Resume Next '<---- [On Error Resume Next] to avoid error if there is no such key in this collection yet.
Call .Remove("val")
On Error GoTo 0
Call .Add(newValue, "val")
End With
End Sub
It is not elegant perhaps, but maybe you can write a sub to update a collection by a key:
Sub UpdateCol(ByRef C As Collection, k As Variant, v As Variant)
On Error Resume Next
C.Remove k
On Error GoTo 0
C.Add v, k
End Sub
Used like this:
Sub Update()
Dim dict As Dictionary
Dim coll As Collection
Set dict = New Dictionary
Set coll = New Collection
coll.Add 100, "val"
coll.Add 3, "n"
dict.Add "coll", coll
Debug.Print dict.Item("coll")("val")
Debug.Print dict.Item("coll")("n")
UpdateCol dict.Item("coll"), "val", dict.Item("coll")("val") + 100
Debug.Print dict.Item("coll")("val")
End Sub
With output as expected:
100
3
200
Here is an approach using a User Defined Object (Class). Hoepfully you can adapt this to your problem.
Rename the Class Module cMyStuff or something else meaningful.
Class Module
Option Explicit
Private pTotalVal As Long
Private pCounter As Long
Public Property Get TotalVal() As Long
TotalVal = pTotalVal
End Property
Public Property Let TotalVal(Value As Long)
pTotalVal = Value
End Property
Public Property Get Counter() As Long
Counter = pCounter
End Property
Public Property Let Counter(Value As Long)
pCounter = Value
End Property
Regular Module
Option Explicit
Sub Update()
Dim cMS As cMyStuff, dMS As Dictionary
Dim I As Long
Set dMS = New Dictionary
For I = 1 To 3
Set cMS = New cMyStuff
With cMS
.Counter = 1
.TotalVal = I * 10
If Not dMS.Exists("coll") Then
dMS.Add "coll", cMS
Else
With dMS("coll")
.TotalVal = .TotalVal + cMS.TotalVal
.Counter = .Counter + 1
End With
End If
End With
Next I
With dMS("coll")
Debug.Print "Total Value", .TotalVal
Debug.Print "Counter", .Counter
End With
End Sub
Results in Immediate Window
Total Value 60
Counter 3
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