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
Related
I'm trying to use a multi-select listbox so users can select cleaning tasks they have completed and mark them as done. While looping through the list I want to see if the item is selected and create a record if so. When I try to use the .List method to return the data from a specific row, I keep getting the method not found error.
I originally did not have the forms 2.0 library loaded so I thought that was the issue, but that did not resolve the problem. I've also compacted and repaired thinking it might just be an odd fluke, but that did not help either.
'loop through values in listbox since its a multi-select
For i = 0 To listCleaningTasks.ListCount - 1
If listCleaningTasks.Selected(i) Then
'add entry to cleaning log
Set rsCleaning = CurrentDb.OpenRecordset("SELECT * FROM cleaning_log;")
With rsCleaning
.AddNew
.Fields("cleaning_task_id") = Form_frmCleaning.listCleaningTasks.List(i)
.Fields("employee_id") = Me.cmbUser
.Fields("cleanroom_id") = Me.cmbCleanroom
.Fields("cleaning_time") = Now()
.Update
.Close
End With
End If
Next i
Any ideas?
Use .listCleaningTasks.ItemData(r) to pull bound column value from row specified by index.
Use .listCleaningTasks.Column(c, r) to pull value specified by column and row indices.
Open and close recordset only one time, outside loop.
Really just need to loop through selected items, not the entire list.
Dim varItem As Variant
If Me.listCleaningTasks.ItemsSelected.Count <> 0 Then
Set rsCleaning = CurrentDb.OpenRecordset("SELECT * FROM cleaning_log")
With rsCleaning
For Each varItem In Me.listCleaningTasks.ItemsSelected
`your code to create record
...
.Fields("cleaning_task_ID") = Me.listCleaningTasks.ItemData(varItem)
...
Next
.Close
End With
Else
MsgBox "No items selected.", vbInformation
End If
Of course the solution of June7 is correct. If you need to store the selected items and then later recall and re-select the list box items, consider to get the selected items comma delimited using this function
Public Function GetSelectedItems(combo As ListBox) As String
Dim result As String, varItem As Variant
For Each varItem In combo.ItemsSelected
result = result & "," & combo.ItemData(varItem)
Next
GetSelectedItems = Mid(result, 2)
End Function
Store it into one column of a table and after reading it back pass it to this sub:
Public Sub CreateComboBoxSelections(combo As ListBox, selections As String)
Dim N As Integer, i As Integer
Dim selectionsArray() As String
selectionsArray = Split(selections, ",")
For i = LBound(selectionsArray) To UBound(selectionsArray)
With combo
For N = .ListCount - 1 To 0 Step -1
If .ItemData(N) = selectionsArray(i) Then
.Selected(N) = True
Exit For
End If
Next N
End With
Next i
End Sub
This will select items in your ListBox as they were before.
I'm trying to filter a list based on input from a textbox. If the item doesn't contain the string, it is deleted from the list. Here is my subroutine:
Sub filterlists(filter As String)
Dim removalDifferential As Integer = 0
For colE As Integer = 0 To RadListView1.Items.Count
Try
Dim itemEpp As ListViewDataItem = Me.RadListView1.Items(colE)
Dim jobname As String = itemEpp(0)
If Not jobname.Contains(filter) Then
' MsgBox(jobname & " Contains " & filter)
RadListView1.Items.RemoveAt(colE - removalDifferential)
removalDifferential = removalDifferential + 1
End If
Catch
End Try
Next
End Sub
Currently this is not deleting the correct items. The TRY is there because when you delete an item the list index changes (which means the for loop length is wrong and will throw outofbounce errors). Any other loop options that will work here?
Assuming you really do want to delete any LVI which simply contains the filter text, you should loop backwards thru the items (any items, not just Listview items) so the index variable will in fact point to the next correct item after a deletion:
For n As Integer = RadListView1.Items.Count-1 to 0 Step -1
If radListView1.Items(n).Text.Contains(filter) Then
RadListView1.Items.RemoveAt(n)
End If
Next
Weird problem. Stepping through the code with inspections gives me correct answers. Just running it doesn't.
This program loops through each cell in a column, searching for a regex match. When it finds something, checks in a adjacent column to which group it belongs and keeps a count in a dictonary. Ex: Group3:7, Group5: 2, Group3:8
Just stepping through the code gives me incorrect results at the end, but adding and inspection for each known item in the dictionary does the trick. Using Debug.Print for each Dictionary(key) to check how many items I got in each loop also gives me a good output.
Correct // What really hapens after running the code
Group1:23 // Group1:23
Group3:21 // Group3:22
Group6:2 // Group6:2
Group7:3 // Group7:6
Group9:8 // Group9:8
Group11:1 // Group11:12
Group12:2 // Group12:21
Sub Proce()
Dim regEx As New VBScript_RegExp_55.RegExp
Dim matches
Dim Rango, RangoJulio, RangoAgosto As String
Dim DictContador As New Scripting.Dictionary
Dim j As Integer
Dim conteo As Integer
Dim Especialidad As String
regEx.Pattern = "cop|col"
regEx.Global = False 'True matches all occurances, False matches the first occurance
regEx.IgnoreCase = True
i = 3
conteo = 1
RangoJulio = "L3:L283"
RangoAgosto = "L3:L315"
Julio = Excel.ActiveWorkbook.Sheets("Julio")
Rango = RangoJulio
Julio.Activate
For Each celda In Julio.Range(Rango)
If regEx.Test(celda.Value) Then
Set matches = regEx.Execute(celda.Value)
For Each Match In matches
j = 13 'column M
Especialidad = Julio.Cells(i, j).Value
If (Not DictContador.Exists(Especialidad)) Then
Call DictContador.Add(Especialidad, conteo)
GoTo ContinueLoop
End If
conteo = DictContador(Especialidad)
conteo = CInt(conteo) + 1
DictContador(Especialidad) = conteo
Next
End If
ContinueLoop:
i = i + 1
'Debug.Print DictContador(key1)
'Debug.Print DictContador(key2)
'etc
Next
'Finally, write the results in another sheet.
End Sub
It's like VBA saying "I'm going to dupe you if I got a chance"
Thanks
Seems like your main loop can be reduced to this:
For Each celda In Julio.Range(Rango)
If regEx.Test(celda.Value) Then
Especialidad = celda.EntireRow.Cells(13).Value
'make sure the key exists: set initial count=0
If (Not DictContador.Exists(Especialidad)) Then _
DictContador.Add Especialidad, 0
'increment the count
DictContador(Especialidad) = DictContador(Especialidad) +1
End If
Next
You're getting different results stepping through the code because there's a bug/feature with dictionaries that if you inspect items using the watch or immediate window the items will be created if they don't already exist.
To see this put a break point at the first line under the variable declarations, press F5 to run to the break point, then in the immediate window type set DictContador = new Dictionary so the dictionary is initialised empty and add a watch for DictContador("a"). You will see "a" added as an item in the locals window.
Collections offer an alternative method that don't have this issue, they also show values rather than keys which may be more useful for debugging. On the other hand an Exists method is lacking so you would either need to add on error resume next and test for errors instead or add a custom collection class with an exists method added. There are trade-offs with both approaches.
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
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.