Nested For Loop dealing with one collection in VBA - vba

Question

I have created a collection of data, and am trying to work with it, and remove items as necessary. Below is my code, and please tell if it is possible to loop through the same collection multiple times at the same time..
I save the first item to a variable, in order to use as reference when searching through the collection. If there is a match then the counter increases, and when the counter is 2 and above I then search the collection to remove the same item from the entire collection. I think the way I have written the code is self explanatory with what I am trying to achieve. If items exist more than once in the collection they need to be removed.
I am getting a runtime error '9' where is set:
tempStorageB = EScoll(j)
I am unsure as to why this is occurring so any guidance/ help is appreciated!
Dim i as Long, j as Long, k as Long
Dim EScoll As New Collection
Dim tempStorageA as Variant
Dim tempStorageB as Variant
Dim tempStorageC as Variant
Dim counter as Integer
For i = 1 To EScoll.Count
tempStorageA = EScoll(i)
'counter loop
For j = 1 To EScoll.Count
tempStorageB = EScoll(j)
If tempStorageB = tempStorageA Then
counter = counter + 1
If counter >= 2 Then
'remove all duplicates from collection loop
For k = EScoll.Count To 1 Step -1
tempStorageC = EScoll(k)
If tempStorageC = tempStorageA Then
EScoll.Remove k
End If
Next k
End If
End If
Next j
Next i
For i = 1 To EScoll.Count
Debug.Print EScoll(i)
Next i

Answer 1

Here is a solution that will remove duplicates from a Collection.
Because of the iterative nature of the search, you have to search and remove one at a time. While this is rather inefficient, the Collection object does not lend itself to being efficient for these operations.
Option Explicit
Sub test()
Dim i As Long, j As Long, k As Long
Dim EScoll As New Collection
PopulateCollection EScoll
Dim duplicatesFound As Boolean
Do
duplicatesFound = False
Dim checkItem As Long
For checkItem = 1 To EScoll.Count
Dim dupIndex As Long
dupIndex = DuplicateItemExists(EScoll, EScoll.Item(checkItem))
If dupIndex > 0 Then
duplicatesFound = True
EScoll.Remove (dupIndex)
'--- kick out of this loop and start again
Exit For
End If
Next checkItem
Loop Until Not duplicatesFound
Debug.Print "dupes removed, count = " & EScoll.Count
End Sub
Function DuplicateItemExists(ByRef thisCollection As Collection, _
ByVal thisValue As Variant) As Long
'--- checks to see if two items have the same given value
' RETURNS the duplicate index number
Dim valueCount As Long
valueCount = 0
Dim i As Long
DuplicateItemExists = 0
For i = 1 To thisCollection.Count
If thisCollection.Item(i) = thisValue Then
valueCount = valueCount + 1
If valueCount > 1 Then
DuplicateItemExists = i
Exit Function
End If
End If
Next i
End Function
Sub PopulateCollection(ByRef thisCollection As Collection)
Const MAX_ITEMS As Long = 50
Dim i As Long
For i = 1 To MAX_ITEMS
thisCollection.Add CLng(Rnd(10) * 10)
Next i
End Sub

Answer 2

Your populating is in same sub, I would delete your duplicates during (just after)
adding)
Sub tsttt()
Dim EScoll As New Collection
Dim DoublesColl As New Collection
Dim x
With EScoll
For Each x In Range("a1:a10").Value 'adjust to your data
On Error Resume Next
.Add x, Format(x)
If Err.Number <> 0 Then
DoublesColl.Add x, Format(x)
On Error GoTo 0
End If
Next
For Each x In DoublesColl
.Remove Format(x)
Next
End With
End Sub

Answer 3

Just to show the solution (for future reference for anyone who has a similar problem) I have come up with the new understanding of the cause of the initial error. The problem being that once setting the count of the for loop to the count of the collection it would not change after an item was deleted. A simple and effective solution for me was to loop through in a similar fashion as above, however, instead of using .Remove I added all the values that were unique to a new collection. See below:
Dim SPcoll As New Collection
For i = 1 To EScoll.Count
tempStorageA = EScoll(i)
counter = 0
For j = 1 To EScoll.Count
tempStorageB = EScoll(j)
If tempStorageB = tempStorageA Then
counter = counter + 1
End If
Next j
If counter < 2 Then
SPcoll.Add tempStorageA
End If
Next i
SPcoll now contains all unique items from previous collection!