Does VBA have dictionary structure? Like key<>value array?
Yes.
Set a reference to MS Scripting runtime ('Microsoft Scripting Runtime'). As per #regjo's comment, go to Tools->References and tick the box for 'Microsoft Scripting Runtime'.
Create a dictionary instance using the code below:
Set dict = CreateObject("Scripting.Dictionary")
or
Dim dict As New Scripting.Dictionary
Example of use:
If Not dict.Exists(key) Then
dict.Add key, value
End If
Don't forget to set the dictionary to Nothing when you have finished using it.
Set dict = Nothing
VBA has the collection object:
Dim c As Collection
Set c = New Collection
c.Add "Data1", "Key1"
c.Add "Data2", "Key2"
c.Add "Data3", "Key3"
'Insert data via key into cell A1
Range("A1").Value = c.Item("Key2")
The Collection object performs key-based lookups using a hash so it's quick.
You can use a Contains() function to check whether a particular collection contains a key:
Public Function Contains(col As Collection, key As Variant) As Boolean
On Error Resume Next
col(key) ' Just try it. If it fails, Err.Number will be nonzero.
Contains = (Err.Number = 0)
Err.Clear
End Function
Edit 24 June 2015: Shorter Contains() thanks to #TWiStErRob.
Edit 25 September 2015: Added Err.Clear() thanks to #scipilot.
VBA does not have an internal implementation of a dictionary, but from VBA you can still use the dictionary object from MS Scripting Runtime Library.
Dim d
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "aaa"
d.Add "b", "bbb"
d.Add "c", "ccc"
If d.Exists("c") Then
MsgBox d("c")
End If
An additional dictionary example that is useful for containing frequency of occurence.
Outside of loop:
Dim dict As New Scripting.dictionary
Dim MyVar as String
Within a loop:
'dictionary
If dict.Exists(MyVar) Then
dict.Item(MyVar) = dict.Item(MyVar) + 1 'increment
Else
dict.Item(MyVar) = 1 'set as 1st occurence
End If
To check on frequency:
Dim i As Integer
For i = 0 To dict.Count - 1 ' lower index 0 (instead of 1)
Debug.Print dict.Items(i) & " " & dict.Keys(i)
Next i
Building off cjrh's answer, we can build a Contains function requiring no labels (I don't like using labels).
Public Function Contains(Col As Collection, Key As String) As Boolean
Contains = True
On Error Resume Next
err.Clear
Col (Key)
If err.Number <> 0 Then
Contains = False
err.Clear
End If
On Error GoTo 0
End Function
For a project of mine, I wrote a set of helper functions to make a Collection behave more like a Dictionary. It still allows recursive collections. You'll notice Key always comes first because it was mandatory and made more sense in my implementation. I also used only String keys. You can change it back if you like.
Set
I renamed this to set because it will overwrite old values.
Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
If (cHas(Col, Key)) Then Col.Remove Key
Col.Add Array(Key, Item), Key
End Sub
Get
The err stuff is for objects since you would pass objects using set and variables without. I think you can just check if it's an object, but I was pressed for time.
Private Function cGet(ByRef Col As Collection, Key As String) As Variant
If Not cHas(Col, Key) Then Exit Function
On Error Resume Next
err.Clear
Set cGet = Col(Key)(1)
If err.Number = 13 Then
err.Clear
cGet = Col(Key)(1)
End If
On Error GoTo 0
If err.Number <> 0 Then Call err.raise(err.Number, err.Source, err.Description, err.HelpFile, err.HelpContext)
End Function
Has
The reason for this post...
Public Function cHas(Col As Collection, Key As String) As Boolean
cHas = True
On Error Resume Next
err.Clear
Col (Key)
If err.Number <> 0 Then
cHas = False
err.Clear
End If
On Error GoTo 0
End Function
Remove
Doesn't throw if it doesn't exist. Just makes sure it's removed.
Private Sub cRemove(ByRef Col As Collection, Key As String)
If cHas(Col, Key) Then Col.Remove Key
End Sub
Keys
Get an array of keys.
Private Function cKeys(ByRef Col As Collection) As String()
Dim Initialized As Boolean
Dim Keys() As String
For Each Item In Col
If Not Initialized Then
ReDim Preserve Keys(0)
Keys(UBound(Keys)) = Item(0)
Initialized = True
Else
ReDim Preserve Keys(UBound(Keys) + 1)
Keys(UBound(Keys)) = Item(0)
End If
Next Item
cKeys = Keys
End Function
The scripting runtime dictionary seems to have a bug that can ruin your design at advanced stages.
If the dictionary value is an array, you cannot update values of elements contained in the array through a reference to the dictionary.
Yes. For VB6, VBA (Excel), and VB.NET
All the others have already mentioned the use of the scripting.runtime version of the Dictionary class. If you are unable to use this DLL you can also use this version, simply add it to your code.
https://github.com/VBA-tools/VBA-Dictionary/blob/master/Dictionary.cls
It is identical to Microsoft's version.
If by any reason, you can't install additional features to your Excel or don't want to, you can use arrays as well, at least for simple problems.
As WhatIsCapital you put name of the country and the function returns you its capital.
Sub arrays()
Dim WhatIsCapital As String, Country As Array, Capital As Array, Answer As String
WhatIsCapital = "Sweden"
Country = Array("UK", "Sweden", "Germany", "France")
Capital = Array("London", "Stockholm", "Berlin", "Paris")
For i = 0 To 10
If WhatIsCapital = Country(i) Then Answer = Capital(i)
Next i
Debug.Print Answer
End Sub
VBA can use the dictionary structure of Scripting.Runtime.
And its implementation is actually a fancy one - just by doing myDict(x) = y, it checks whether there is a key x in the dictionary and if there is not such, it even creates it. If it is there, it uses it.
And it does not "yell" or "complain" about this extra step, performed "under the hood". Of course, you may check explicitly, whether a key exists with Dictionary.Exists(key). Thus, these 5 lines:
If myDict.exists("B") Then
myDict("B") = myDict("B") + i * 3
Else
myDict.Add "B", i * 3
End If
are the same as this 1 liner - myDict("B") = myDict("B") + i * 3. Check it out:
Sub TestMe()
Dim myDict As Object, i As Long, myKey As Variant
Set myDict = CreateObject("Scripting.Dictionary")
For i = 1 To 3
Debug.Print myDict.Exists("A")
myDict("A") = myDict("A") + i
myDict("B") = myDict("B") + 5
Next i
For Each myKey In myDict.keys
Debug.Print myKey; myDict(myKey)
Next myKey
End Sub
You can access a non-Native HashTable through System.Collections.HashTable.
HashTable
Represents a collection of key/value pairs that are organized based on
the hash code of the key.
Not sure you would ever want to use this over Scripting.Dictionary but adding here for the sake of completeness. You can review the methods in case there are some of interest e.g. Clone, CopyTo
Example:
Option Explicit
Public Sub UsingHashTable()
Dim h As Object
Set h = CreateObject("System.Collections.HashTable")
h.Add "A", 1
' h.Add "A", 1 ''<< Will throw duplicate key error
h.Add "B", 2
h("B") = 2
Dim keys As mscorlib.IEnumerable 'Need to cast in order to enumerate 'https://stackoverflow.com/a/56705428/6241235
Set keys = h.keys
Dim k As Variant
For Each k In keys
Debug.Print k, h(k) 'outputs the key and its associated value
Next
End Sub
This answer by #MathieuGuindon gives plenty of detail about HashTable and also why it is necessary to use mscorlib.IEnumerable (early bound reference to mscorlib) in order to enumerate the key:value pairs.
Related
I am comparing two VBA scripting dictionaries. Particularly, I want to know if the keys that have the same name (in this example, "Dogs") also have the same values/items assigned to them. If there is a mismatch (one key has more items than the other), I want to know where the difference comes from.
In this example, I have two identically named keys in two scripting dictionaries, but one has 3 values and the other has 4.
I want to see which values ("Mixed" and "Cat") are missing from the key in the first dictionary. I then want to make a string of the values that are missing.
Set Dictionary1 = CreateObject("scripting.dictionary")
Set Dictionary2 = CreateObject("scripting.dictionary")
Dictionary1.Add "Dogs", Array("Beagle", "Setter", "Chiuhuaha")
Dictionary2.Add "Dogs", Array("Beagle", "Setter", "Chiuhuaha", "Mixed", "Cat")
Objective:
MissingItems = Mixed &" "& Cat
MsgBox "The missing items in Dogs are" & MissingItems
Does anyone have an idea of how this could be achieved? I'd greatly appreciate it if you could suggest the code wording to use. I'm so stuck!
Try this:
Option Explicit
Sub Test()
Dim dictionary1 As Object: Set dictionary1 = CreateObject("scripting.dictionary")
Dim dictionary2 As Object: Set dictionary2 = CreateObject("scripting.dictionary")
dictionary1.Add "Dogs", Array("Beagle", "Setter", "Chiuhuaha")
dictionary2.Add "Dogs", Array("Beagle", "Setter", "Chiuhuaha", "Mixed", "Cat")
Const myKey As String = "Dogs"
'Exit if key is missing from any of the dictionaries
If Not dictionary1.Exists(myKey) Then Exit Sub
If Not dictionary2.Exists(myKey) Then Exit Sub
Dim elements1 As Object: Set elements1 = CreateObject("scripting.dictionary")
Dim v As Variant
Dim missingElements As Object: Set missingElements = CreateObject("scripting.dictionary")
'Create another dictionary with the elements of the first array
For Each v In dictionary1(myKey)
elements1(v) = Empty 'This creates the key if missing and makes sure you don't have duplicates
Next v
'Check all missing elements from the second array
For Each v In dictionary2(myKey)
If Not elements1.Exists(v) Then
missingElements(v) = Empty
End If
Next v
If missingElements.Count = 0 Then
MsgBox "No items missing in " & myKey, vbInformation, "Result"
Else
MsgBox "The missing items in " & myKey & " are: " & Join(missingElements.Keys, " ")
End If
End Sub
I am trying to create an array with all the worksheet names in my workbook that have the word 'Template' in it. I thought the easiest way to do this would be to create a collection first and then convert it to an array but I am having trouble. Right now the error I am getting is on the
collectionToArray (col)
line. I am receiving an
Argument Not Optional error
Pretty stuck, any help is super appreciated. Thanks!!
Public col As New Collection
Public Sub Test()
For Each ws In ThisWorkbook.Worksheets
If InStr(ws.Name, "Template") <> 0 Then
col.Add ws.Name
End If
Next ws
collectionToArray (col)
End Sub
Function collectionToArray(c As Collection) As Variant()
Dim a() As Variant: ReDim a(0 To c.Count - 1)
Dim i As Integer
For i = 1 To c.Count
a(i - 1) = c.Item(i)
Next
collectionToArray = a
End Function
collectionToArray (col)
Notice that whitespace between the function's name and its argument list? That's the VBE telling you this:
I'll take that argument, evaluate it as a value, then pass it ByVal to that procedure you're calling, even if the signature for that procedure says ByRef, explicitly or not.
This "extraneous parentheses" habit is inevitably going to make you bump into weird "Object Required" runtime errors at one point or another: lose it.
The Function is overdoing it IMO: a Variant can perfectly well wrap an array, so I'd change its signature to return a Variant instead of a Variant().
Integer being a 16-bit signed integer type (i.e. short in some other languages), it's probably a better idea to use a Long instead (32-bit signed integer, i.e. int in some other languages) - that way you'll avoid running into "Overflow" issues when you need to deal with more than 32,767 values (especially common if a worksheet is involved).
Public col As New Collection
This makes col an auto-instantiated object variable, and it has potentially surprising side-effects. Consider this code:
Dim c As New Collection
c.Add 42
Set c = Nothing
c.Add 42
Debug.Print c.Count
What do you expect this code to do? If you thought "error 91, because the object reference is Nothing", you've been bitten by auto-instantiation. Best avoid it, and keep declaration and assignments as separate instructions.
Other than that, CLR's answer has your solution: a Function should return a value, that the calling code should consume.
result = MyFunction(args)
You'll notice the VBE clearing any whitespace you might be tempted to add between MyFunction and (args) here: that's the VBE telling you this:
I'll take that argument, pass it to MyFunction, and assign the function's return value to result.
It's all there, you're just not using the Function as a function. You need to store the result in something, like 'NewArray'..?
Public col As New Collection
Public Sub Test()
For Each ws In ThisWorkbook.Worksheets
If InStr(ws.Name, "Template") <> 0 Then
col.Add ws.Name
End If
Next ws
' Tweaked as per Vityata's comment
If col.Count > 0 Then
newarray = collectionToArray(col)
Else
' Do something else
End If
End Sub
Function collectionToArray(c As Collection) As Variant()
Dim a() As Variant: ReDim a(0 To c.Count - 1)
Dim i As Integer
For i = 1 To c.Count
a(i - 1) = c.Item(i)
Next
collectionToArray = a
End Function
This is my collectionToArray function:
Public Function CollectionToArray(myCol As Collection) As Variant
Dim result As Variant
Dim cnt As Long
If myCol.Count = 0 Then
CollectionToArray = Array()
Exit Function
End If
ReDim result(myCol.Count - 1)
For cnt = 0 To myCol.Count - 1
result(cnt) = myCol(cnt + 1)
Next cnt
CollectionToArray = result
End Function
It is better than the one you are using, because it will not give an error, if the collection is empty.
To avoid the error on an empty collection in your case, you may consider adding a check like this:
If col.Count > 0 Then k = CollectionToArray(col)
Instead of using a standard collection, you can use a dictionary because of the .keys method that can transfer all info to an array. Less coding, simple :)
Dim ws As Worksheet
Dim arr
Dim Dic As Scripting.Dictionary
Set Dic = New Dictionary
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "Template" Then
Dic.Add ws.Name, "Awesome"
End If
Next ws
arr = Dic.Keys
I am going to write some code to illustrate the question.
For Each oElement in myArray
MsgBox oElement
Next
This would print a message saying the value of "oElement" contained in "myArray" as many times as there is elements in "myArray".
However, what if i want to know the id of "oElement"? is there properties of "oElement" that i can access? something like printing the number of oelement instead of the value of the oelement?
For Each oElement in myArray
MsgBox oElement.ID
Next
Is it possible? is there properties that can be accessed?
Thanks in advance for your time and attention,
No, there's no way to get the index of the item in the array. You have to maintain a separate variable:
Dim Index As Integer
Index = 0
For Each oElement In myArray
Print Index
Index = Index + 1
Next
a workaround could be the use of a Dictionary object instead of a Variant array:
Sub main()
Dim myDict As Scripting.Dictionary
Dim key As Variant
Set myDict = GetDict '<--| get your "test" dictionary with "indexes" as 'keys' and "elements" as 'items'
For Each key In myDict.Keys '<--| iterate over keys (i.e. over your "indexes")
MsgBox key '<--| this will give you the "index"
MsgBox myDict(key) '<--| this will give you the "element"
Next key
End Sub
where it's used the following function to return a "test" dictionary
Function GetDict() As Scripting.Dictionary
'function to return a test dictionary
Dim i As Long
Dim myDict As New Scripting.Dictionary
For i = 1 To 10
myDict.Add i, "string-" & CStr(i) '<--| use the 'key' as your "index" and the 'item' as your element
Next i
Set GetDict = myDict
End Function
In truth, the following reverse approach could seem more similar to your initial code:
Sub main()
Dim myDict As Scripting.Dictionary
Dim oElement As Variant
Set myDict = GetDict2 '<--| get your "test" dictionary with "elements" as 'keys' and "indexes" as 'items'
For Each oElement In myDict.Keys '<--| iterate over dictionary keys (i.e. over your "elements")
MsgBox myDict(oElement) '<--| this will give you the "index"
MsgBox oElement '<--| this will give you the "element"
Next oElement
End Sub
where the following function is used:
Function GetDict2() As Scripting.Dictionary
Dim i As Long
Dim myDict As New Scripting.Dictionary
For i = 1 To 10
myDict.Add "string-" & CStr(i), i '<--| use the 'key' as your "element" and the 'item' as your key
Next i
Set GetDict2 = myDict
End Function
but it'd have the major drawback of using your "elements" as keys, thus possibly violating their uniqueness, while sequential integers would always comply this requirement
How do I remove the currently looped item from a collection? I get run-time error 13: Type mismatch on the line wls.Remove vl
Sub FocusOnH(ByRef vls As Collection)
Dim vl As CVegetableLine
For Each vl In vls
If vl.hValue <> 0 Then
vl.volume = vl.hValue
Else
vls.Remove vl
End If
Next vl
End Sub
You must delete item while looping through the collection in backward order, otherwise it will cause error.
Sub TestRemoveItemInCollection()
Dim col As Collection, i As Integer
Set col = New Collection
col.Add "item1"
col.Add "item2"
col.Add "item3"
col.Add "item4"
' Never use: For i=1 to col.Count
For i = col.Count To 1 Step -1
col.Remove i
Next i
Set col = Nothing
End Sub
Why? Because Visual Basic collections are re-indexed automatically. If you try to delete in forward order, it will conflict with the outer loop and hence get the tricky error.
Another example, to remove all items in the collection can be done like this:
For i = 1 to col.Count
col.Remove 1 'Always remove the first item.
Next i
Collection.Remove() method takes either key (if provided with the .Add() method) or index (by default) as parameter, so you can't provide an user-defined object as parameter to the Remove() method which explains the Type-mismatch error.
See a more on MSDN
You should really be using a Dictionary collection if you are working with User Defined Types.
To achieve what you want use an iterator
dim i as long
for i = Collection.Count to 1 step -1
'Collection.Remove i
next i
In VB.NET, I can iterate through a dictionary's key/value pairs:
Dictionary<string, string> collection = new Dictionary<string, string>();
collection.Add("key1", "value1");
collection.Add("key2", "value2");
foreach (string key in collection.Keys)
{
MessageBox.Show("Key: " + key + ". Value: " + collection[key]);
}
I know in VBA I can iterate through the values of a Collection object:
Dim Col As Collection
Set Col = New Collection
Dim i As Integer
Col.Add "value1", "key1"
Col.Add "value2", "key2"
For i = 1 To Col.Count
MsgBox (Col.Item(i))
Next I
I also know that I do this with a Scripting.Dictionary VBA object, but I was wondering if this is possible with collections.
Can I iterate through key/value pairs in a VBA collection?
you cannot retrieve the name of the key from a collection. Instead, you'd need to use a Dictionary Object:
Sub LoopKeys()
Dim key As Variant
'Early binding: add reference to MS Scripting Runtime
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
'Use this for late binding instead:
'Dim dic As Object
'Set dic = CreateObject("Scripting.Dictionary")
dic.Add "Key1", "Value1"
dic.Add "Key2", "Value2"
For Each key In dic.Keys
Debug.Print "Key: " & key & " Value: " & dic(key)
Next
End Sub
This answwer is not iterating over keys of a collection - which seems to be impossible, but gives some more workarounds if you do not want to use a Dictionary.
You can do a collection of KeyValues as outlined in https://stackoverflow.com/a/9935108/586754 . (Create keyvalue class and put those into the collection.)
In my (non Excel but SSRS) case I could not add a class and did not want to add a .net reference.
I used 2 collections, 1 to store keys and 1 to store values, and then kept them in sync when adding or deleting.
The following shows the add as an example - though it is limited to string/int key/value, and the int value s not stored but added to previous values, which was needed for me aggregating values in SSRS. This could be easily modified though to not add but store values.
ck key collection, cv value collection.
Private Sub StoreAdd(ck As Collection, cv As Collection, k As String, v As Integer)
Dim i As Integer
Dim found As Boolean = false
Dim val As Integer = v
For i = 1 to ck.Count
if k = ck(i)
' existing, value is present
val = val + cv(i)
' remove, will be added later again
ck.Remove(i)
cv.Remove(i)
End If
if i <= ck.Count
' relevant for ordering
If k > ck(i)
' insert at appropriate place
ck.Add(k, k, i)
cv.Add(val, k, i)
found = true
Exit For
End If
End If
Next i
if not found
' insert at end
ck.Add(k, k)
cv.Add(val, k)
End If
End Sub