How to put an array into a collection in VBA? - vba

Question

This is my first foray into VBA.
How can I put an array into a collection? I am making a collection with keys which contains reference data. It gets made once, and then used throughout my program. Everything I've found is either reading data in from a sheet in Excel, taking user input, or just putting in a couple of previously defined arrays; I want to do the initialisation of the arrays in the add call to the collection, as they aren't going to be used anywhere else.
I want to do something along the lines of
Dim c As Collection
Set c = New Collection
c.Add((1,"B"), "B")
c.Add((1.014,"FeC"), "Fe")
... 'about 100 lines
I can then retrieve the data by key, rather then having a hard to maintain If/ElseIf.
In Python, I would do
c = {"B": (1,"B"), "Fe": (1.014,"FeC"), ...}

Answer 1

A strange day. Two questions where I can use the same answer (see Convert 2 collections to a dictionary).
The basic advice I would give is to use a Scripting.Dictionary if only for the reason that you can get arrays back out using the Keys and Items Methods.
Here is the answer reproduced from the reference above
Inserting two collections (or any combination of an array or collection) into a dictionary is essentially boilerplate code. The best way to deal with boilerplate code is to put it in the object so that scripting dictionary would end up with a Method called 'AddPairs'.
In VBA you can't do this directly. Instead, you have to use a Wrapper, which is a term used for putting an object inside another object and using pass through methods to use the inner object. The class below 'wDictionary', shows how to Wrap the Scripting.Dictionary object to add the functionality you desire, plus an additional method which does what you want in reverse.
The AddPairs Method allows collections or Arrays to be used for the Keys and Items so, assuming you are now using wCollection you can write
pairs.AddPairs rembs, cols
The wDictionary also has a 'Pairs' method. The pairs method returns an array in the same way as the 'Items' and 'Keys' methods, but, each Item is an array of three Items, the Index, Key and Item. If you've been programming for a while, you'll understand the utility of the Pairs method.
Save the code below as a .cls file and then import it into your project. Replace references to Scripting.Dictionary with wDictionary (or New wDictionary if you are using CreateObject)
The code below is provided as an example. I haven't run any tests but I have done Rubberduck code inspections to ensure that there are no obvious errors.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "wDictionary"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Type State
Host As Scripting.Dictionary
End Type
Private s As State
Private Sub Class_Initialize()
Set s.Host = New Scripting.Dictionary
End Sub
Public Sub Add(ByRef Key As Variant, ByRef Item As Variant)
s.Host.Add Key, Item
End Sub
' An Enhancement - The Keys and Items variants must support For each and (Index) or defaultmemeber .Item(Index)
Public Sub AddPairs(ByVal Keys As Variant, ByRef Items As Variant)
Dim myItemsIndex As Long
Dim myLastItemsIndex As Long
If TypeName(Items) = "Collection" Then
myItemsIndex = 1
myLastItemsIndex = Items.Count
Else
myItemsIndex = LBound(Items)
myLastItemsIndex = UBound(Items)
End If
Dim myKey As Variant
For Each myKey In Keys
If myItemsIndex > myLastItemsIndex Then
Exit For
Else
s.Host.Add myKey, Items(myItemsIndex)
myItemsIndex = myItemsIndex + 1
End If
Next
End Sub
Public Property Get CompareMode() As VbCompareMethod
CompareMode = s.Host.CompareMode
End Property
Public Property Let CompareMode(ByVal RHS As VbCompareMethod)
s.Host.CompareMode = RHS
End Property
Public Property Get Count() As Long
Count = s.Host.Count
End Property
Public Function Exists(ByRef Key As Variant) As Boolean
Exists = s.Host.Exists(Key)
End Function
'#DefaultMember
Public Property Get Item(ByRef Key As Variant) As Variant
Attribute Item.VB_UserMemId = 0
If VBA.IsObject(s.Host(Key)) Then
Set Item = s.Host(Key)
Else
Item = s.Host(Key)
End If
End Property
Public Property Let Item(ByRef Key As Variant, ByVal RHS As Variant)
s.Host(Key) = RHS
End Property
Public Property Set Item(ByRef Key As Variant, ByVal RHS As Variant)
Set s.Host(Key) = RHS
End Property
Public Function Items() As Variant
Items = s.Host.Items
End Function
Public Function Keys() As Variant
Keys = s.Host.Keys
End Function
' An enhancement For Each myItem in myDictionary.Pairs return an array containing an index, key and value (items 0,1,2 respectively)
Public Function Pairs() As Variant
Dim myPairs As Variant
ReDim myPairs(0 To s.Host.Count - 1)
Dim myIndex As Long
myIndex = 0
Dim myKey As Variant
For Each myKey In s.Host
myPairs(myIndex) = Array(myIndex, myKey, s.Host(myKey))
myIndex = myIndex + 1
Next
Pairs = myPairs
End Function
Public Property Let Key(ByRef Key As Variant, ByVal NewKey As Variant)
s.Host.Key(Key) = NewKey
End Property
Public Sub Remove(ByRef Key As Variant)
s.Host.Remove Key
End Sub
Public Sub RemoveAll()
s.Host.RemoveAll
End Sub
Update
Of course, the above is quite tedious to write, even though you any have to do the base wrapping once. This is where twinBasic (the up and coming replacement for VB/VBA) has a definite edge. In twin basic the whole code presented above can be condensed to
Class wDictionary
Implements Scripting.dictionary Via Host = New scripting.dictionary
' An enhancement For Each myItem in myDictionary.Pairs return an array containing an index, key and value (items 0,1,2 respectively)
Public Function Pairs() As Variant
Dim myPairs As Variant
ReDim myPairs(0 To s.Host.Count - 1)
Dim myIndex As Long = 0
Dim myKey As Variant
For Each myKey In Host
myPairs(myIndex) = Array(myIndex, myKey, s.Host(myKey))
myIndex += 1
Next
Return myPairs
End Function
' An Enhancement - The Keys and Items variants must support For each and (Index) or defaultmemeber .Item(Index)
Public Sub AddPairs(ByVal Keys As Variant, ByRef Items As Variant)
Dim myItemsIndex As Long
Dim myLastItemsIndex As Long
If TypeName(Items) = "Collection" Then
myItemsIndex = 1
myLastItemsIndex = Items.Count
Else
myItemsIndex = LBound(Items)
myLastItemsIndex = UBound(Items)
End If
Dim myKey As Variant
For Each myKey In Keys
If myItemsIndex > myLastItemsIndex Then
Exit For
Else
Host.Add myKey, Items(myItemsIndex)
myItemsIndex += 1
End If
Next
End Sub
End Class
What's more, twinBasic makes it absolutely trivial to convert wCollection to an activeX.dll so that you can just add a reference to wCOllection just as you do for Scripting.DIctionary etc.