I have following values, and I want to add these to a collection. If the values are already in the collection, a message should show "this is already added in your collection".
Dim OrdLines As New Collection
OrdLines.Add (111,this is first item)
OrdLines.Add (222,this is second item)
OrdLines.Add (333,this is third item)
OrdLines.Add (444,this is fourth item)
How do I avoid duplicate values in a collection?
To avoid duplicates without any prompts use this method.
Code
Sub Sample()
Dim col As New Collection
Dim itm
On Error Resume Next
col.Add 111, Cstr(111)
col.Add 222, Cstr(222)
col.Add 111, Cstr(111)
col.Add 111, Cstr(111)
col.Add 333, Cstr(333)
col.Add 111, Cstr(111)
col.Add 444, Cstr(444)
col.Add 555, Cstr(555)
On Error GoTo 0
For Each itm In col
Debug.Print itm
Next
End Sub
ScreenShot
Explanation
A collection is an ordered set of items that you can refer to as a unit. The syntax is
col.Add item, key, before, after
A collection cannot have the same key twice so what we are doing is creating a key using the item that we are adding. This will ensure that we will not get duplicates. The On Error Resume Next is just telling the code to ignore the error we get when we try to add a duplicate and simply move on to the next item to add. The CHR(34) is nothing but " so the above statement can also be written as
col.Add 111, """" & 111 & """"
Suggested Read
The Visual Basic Collection Object
HTH
This is one of those scenarios where a Dictionary offers some advantages.
Option Explicit
'Requires a reference to Microsoft Scripting Runtime.
Private Sub Main()
Dim Dict As Scripting.Dictionary 'As New XXX adds overhead.
Dim Item As Variant
Set Dict = New Scripting.Dictionary
With Dict
.Item(111) = 111
.Item(222) = 222
.Item(111) = 111
.Item(111) = 111
.Item(333) = 333
.Item(111) = 111
.Item(222) = 222
.Item(333) = 333
For Each Item In .Items
Debug.Print Item
Next
End With
End Sub
There is a built in method that allows you check for duplicates, assuming you are always assigning a Key value. This is preferably than On Error Resume Next.
If Not OrdLines.Contains(key_value) Then
OrdLines.Add(item_value, key_value, before, after)
End If
NOTE This is VB.NET, not VBA/VB6. In VBA/VB6 you could write a custom function similar to the approach given, here.
Use the Add method along with key.
Syntax:
OrderLines.Add(ObjectToAdd, Key)
Remember key is a string.
Example:
OrdLines.Add(222,"222")
OrdLines.Add(222,"333")
OrdLines.Add(222,"444")
OrdLines.Add(222,"222") 'This will give error
Related
Why the following code causes an error: -2146233079(80131509).
Sub testSortedList()
Dim list
Set list = CreateObject("System.Collections.SortedList")
list.Add 1978340499, "a"
list.Add 1, "b"
End Sub
They keys of the list needs to be of same data type. You add two different data types, the first is of type Long, the second of type Integer and this throws the error message *failed to compare two elements..."
Simplest work around: Append an & to the 1, this will force VBA to store your constant as a Long:
list.Add 1&, "b"
Or use variables for your key values:
Dim key as Long
key = 1
list.Add key, "b"
I am having a lot of trouble understanding the output for the below code snippet
Sub TestDictionary
Dim d as dictionary
set d = new dictionary
debug.print d.count
debug.print d(1)
debug.print d.count
End Sub
The above snippet gives the o/p as below
0
`I presume this line being the empty string
1
I expected subscript out of range for line debug.print d(1), But to my horror it returned an empty string.
Can anyone enlighten me why this is happening?
That's the correct behavior. The Scripting.Dictionary object is made in such a way that dict(x) = something either assigns to an existing entry or creates the entry if none.
Also reading dict(x) creates the entry with an empty Variant if no entry already exists.
This is how the Scripting.Dictionary is specified, and this behavior is useful in many situations.
Notice that you can change this behavior in your code, by simply checking if the entry exists before accessing it:
If dict.exists(x) then
do something with dict(x)...
End If
So your code above could be written this way:
Sub TestDictionary
Dim d as dictionary
set d = new dictionary
debug.print d.count
if d.Exists("1") then Debug.Print d("1")
debug.print d.count
End Sub
Also notice that the key is a String. You dont expect to have the integer as an index like an array. d(1) is just an entry that could be placed anywhere, with the key string "1".
It's because with d(1) you're directly accessing the dictionary item corresponding to "1" key and if there's no such key then VBScript creates it under the hood. That's why the subsequent d.count returns 1
You can have some deeper testing as follows:
Sub TestDictionary()
Dim d As Dictionary
Set d = New Dictionary
Debug.Print d.count '--> returns 0
Debug.Print d.keys(0) '--> returns an error, there are no keys, yet
Debug.Print d(4) '--> returns "", i.e. the not defined item associated with the newly created key (which is "4")
Debug.Print d.keys(0) '--> returns "4", i.e. the first (and only) dictionary key
Debug.Print d.keys(1) '--> returns an error, since there's only one item in the dictionary
Debug.Print d.Exists(1) '--> returns False, since there's no "1" key in the dictionary
Debug.Print d.Exists(4) '--> returns True, since there's a "4" key in the dictionary
Debug.Print d.count '--> 1, since the third statement created a dictionary item
End Sub
Bottom Line: Use Dictionary Count property to know if it has any item and Exist(key) property if you're looking for a specific key
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
Is there any way to find the key that corresponds to a given item in a VBA dictionary?
http://msdn.microsoft.com/en-us/library/aa164502%28v=office.10%29.aspx
MSDN suggests that the "Key" property can be used, but when I try using it I get an error ("Compile error: invalid use of property"). I've found in the past that the "Exists" method given here doesn't work for me either, so I assume that they were the commands in a previous version of Office and are now outdated. However I haven't been able to find an equivalent for the latest version of Office.
I could use a for each loop to create a new dictionary where the keys in the old dictionary are the items in the new dictionary (and vice versa) and then use ".Item", but I was wondering if there was an inbuilt command that would allow me to avoid this.
but I was wondering if there was an inbuilt command that would allow me to avoid this.
Nope there is no inbuilt command as such. You will have to resort to some kind of looping. Here is one example. I created a small function to get the key corresponding to an item in a dictionary.
Dim Dict As Dictionary
Sub Sample()
Set Dict = New Dictionary
With Dict
.CompareMode = vbBinaryCompare
For i = 1 To 10
.Add i, "Item " & i
Next i
End With
Debug.Print GetKey(Dict, "Item 3")
End Sub
Function GetKey(Dic As Dictionary, strItem As String) As String
Dim key As Variant
For Each key In Dic.Keys
If Dic.Item(key) = strItem Then
GetKey = CStr(key)
Exit Function
End If
Next
End Function
An alternate solution(..?)
Instead of going through each item in the dictionary for a match, how about you maintain 2 dictionary objects? The second one, using value as the key and key as its value. When u add an item, u add it both the dictionaries. If you have a key, you look it up in the first dictionary and if you have the value, u look it up in the second one.
Actually, there is an Exists method that will do exactly what you want. Here's how it works:
...
Dim dict
Set dict = CreateObject("Scripting.Dictionary")
dict.Add "utensil", "spork"
Debug.Print dict.Exists("utensil")
The above returns True.
From this, I first thought that .exists(key) is enterely useless.
But there IS an easy circumvention.
First, let me mention a futile attempt:
make sure the first time you refer to the value to check, you assign
.exists(key) to a boolean variable.
if the value of that boolean is FALSE, immediately remove the dictionary
entry that was inadvertently created when you tested the key
Well, that works, but the next time you test for existence again with this code
itExists = a.exists(key)
you may get a 424 error -- the implementor of .exists REALLY failed. But the following will work (or at least, for me it does... so far)
if isempty(a.item(key)) then ' checking on value of the object
a.remove(key)
a.add key, value
else ' you have a key duplicate
' do something about dupe, like quit
end if
For a little clarification, you can look at the following example code below
Sub aDict()
Dim a As Dictionary
Dim x As Long
Set a = New Dictionary
With a
On Error Resume Next
' first add
.Add 1, "sumpn"
' second add
.Add "dog", "beagle"
x = 66
' third add
.Add "sixty", x
printd a, 1, "added with numerical key"
printd a, 2, "added with string key = dog, using numeric key=2"
Stop ' look at count of items: we added 3, but have 4 in local vars
printd a, "2", "searching string key '2', not retrieving 2nd added"
printd a, 9, "should not exist, first try"
' but the .exists has created it!!
printd a, 9, "should not exist, second try, *** but now created ***"
printd a, 8, "never seen anywhere"
Stop ' look at a in local vars!! #8 exists now as item 7
a.Remove 8 ' so we kill it
' *************************** the great fixit *******
Stop ' observe that #8 (item 7) is gone again
printd a, "dog", "added as second position (Item 2)"
' fourth add
.Add 1, "else" ' doublette
printd a, 1, "position 1 is taken, Err=457 is correct"
' fifth add
.Add 3, "beagle"
printd a, "3", "string key='3' <> numeric 3"
' 6th add
.Add 5, "beagle"
printd a, "beagle", "value is already there with key 'dog'"
printd a, 5, "numeric key=5"
End With
End Sub
Sub printd(a As Dictionary, mkey, Optional msg As String)
Dim ex As Boolean
With a
If Err.number <> 0 Then
Debug.Print mkey, "error " & Err.number, Err.Description
End If
Err.clear
ex = .Exists(mkey) ' very first reference to a.Exists(mkey)
Debug.Print "key " & mkey, "a(" & mkey & ")" & a(mkey), _
"Exists", ex, "a.item " & .Item(mkey), msg
If Err.number <> 0 Then
Debug.Print mkey, "error " & Err.number, Err.Description
End If
End With
End Sub
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.