Nested For Loop dealing with one collection in 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

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!

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

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