Excel VBA - Collection error

Question

I am trying to build a collection and take the Count of Unique Values from that Collection but am getting an error in building a Collection itself. Can anyone suggest me where I am going wrong. Kindly Share your thoughts. Please let me know how to find out the COUNT of UNIQUE VALUES as well.

Sub trial()

Dim sampleVisualBasicColl As Collection

For i = 2 To 10

    Rng = Range("M" & i).value

    StartsWith = Left(Rng, 3)

    If StartsWith = "Joh" Then

            sampleVisualBasicColl.Add Rng

    Else

    End If

Next

Debug.Print (sampleVisualBasicCol1)

End Sub

Just noticed - isn't this pretty much a duplicate of what you asked yesterday? stackoverflow.com/questions/43314311/… — Darren Bartrup-Cook
– Darren Bartrup-Cook, Commented Apr 10, 2017 at 13:14

Community · Accepted Answer · 2017-05-23 12:32:29Z

1

Using a collection you can just add Joh to the collection and then count the items:

'Using a collection
Sub Col_test()

    Dim cCol As Collection
    Dim i As Long

    Set cCol = New Collection

    On Error GoTo Err_Handler

    With ThisWorkbook.Worksheets("Sheet1")
        For i = 2 To 20
            If Left(.Cells(i, 13), 3) = "Joh" Then
                cCol.Add .Cells(i, 13).Value, .Cells(i, 13).Value
            End If
        Next i
    End With

    Debug.Print cCol.Count

    On Error GoTo 0

Exit Sub
Err_Handler:
    Select Case Err.Number
        Case 457 'This key is already associated with an element of this collection
            Err.Clear
            Resume Next
        Case Else
            MsgBox "Error " & Err.Number & vbCr & _
                " (" & Err.Description & ") in procedure Col_test."
            Err.Clear
    End Select

End Sub

If you want the count of each item (Joh, Ben... whatever else you have) then use a dictionary:

'Using a dictionary.
Sub Dic_Test()

    Dim dict As Object
    Dim i As Long
    Dim sValue As String
    Dim key As Variant

    Set dict = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Sheet1")
        For i = 2 To 20
            If Len(.Cells(i, 13)) >= 3 Then
                sValue = Left(.Cells(i, 13), 3)
                If dict.exists(sValue) Then
                    dict(sValue) = dict(sValue) + 1
                Else
                    dict(sValue) = 1
                End If
            End If
        Next i
    End With

    For Each key In dict.keys
        Debug.Print key & " = " & dict(key)
    Next key

End Sub

Note: I'm using Cells within the code rather than Range. Cells(2,13) is M2 (13th column, 2nd row).

I find this link very helpful with dictionaries: https://excelmacromastery.com/vba-dictionary/

As a further update (after answer accepted) and using the lists you gave in your question here: Excel VBA - Formula Counting Unique Value error this code with dictionaries will return Joh = 4, Ian = 3

'Using a dictionary.
Sub Dic_Test()

    Dim dict As Object
    Dim dictFinal As Object
    Dim i As Long
    Dim sValue As String
    Dim key As Variant
    Dim keyFinal As String

    Set dict = CreateObject("Scripting.Dictionary")
    Set dictFinal = CreateObject("Scripting.Dictionary")

    'Get the unique values from the worksheet.
    With ThisWorkbook.Worksheets("Sheet1")
        For i = 2 To 20
            If Len(.Cells(i, 13)) >= 3 Then
                sValue = .Cells(i, 13).Value
                If dict.exists(sValue) Then
                    dict(sValue) = dict(sValue) + 1
                Else
                    dict(sValue) = 1
                End If
            End If
        Next i
    End With

    'Count the unique values in dict.
    For Each key In dict.keys
        keyFinal = Left(key, 3)
        If dictFinal.exists(keyFinal) Then
            dictFinal(keyFinal) = dictFinal(keyFinal) + 1
        Else
            dictFinal(keyFinal) = 1
        End If
    Next key

    For Each key In dictFinal.keys
        Debug.Print key & " = " & dictFinal(key)
    Next key

End Sub

edited May 23, 2017 at 12:32

CommunityBot

11 silver badge

answered Apr 10, 2017 at 12:42

Darren Bartrup-Cook

20.2k2 gold badges27 silver badges50 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

Student of the Digital World Over a year ago

@Dareen Bartup-Cook Thanks for the hand. But I am looking for Unique Counts. Not the Counts. Unique for John alone. Say JohnRed,JohnRed,JohnBlue,JohnGreen then the Unique for John will be 3.

Darren Bartrup-Cook Over a year ago

Ah, ok.... so JohnRed counts as 1. Count the "Joh" but combine the exact duplicates.

Student of the Digital World Over a year ago

Yes Sir. That's were I am struck. How to combine the exact duplicates? or to delete the duplicates programmatically,

Darren Bartrup-Cook Over a year ago

I've updated the Collections code to include an error handler and use the full text in the cell as a key. The key in a collection can't be repeated - it will throw err #457 if you try.

Absinthe · Accepted Answer · 2017-04-10 12:39:08Z

1

You need to create the collection as well as declaring it.

Sub trial()

Dim myCol As Collection

Set myCol= New Collection ' creates the collection

For i = 2 To 10

    Rng = Range("M" & i).value

    StartsWith = Left(Rng, 3)

    If StartsWith = "Joh" Then

            myCol.Add Rng

    Else

    End If

Next

For each x in myCol
   Debug.Print x
Next x

End Sub

edited Apr 10, 2017 at 12:39

answered Apr 10, 2017 at 12:10

Absinthe

3,4218 gold badges37 silver badges75 bronze badges

2 Comments

Student of the Digital World Over a year ago

No, This doesn't get me the collection as well. Debug.Print gives me the empty result

Absinthe Over a year ago

For one thing you can't print a collection like that, you need to specify which index you want to print. For another it wasn't liking the name of your collection for some reason. Try the amended code above, tested & working.

Rajesh Sinha · Accepted Answer · 2017-04-10 12:55:34Z

0

Hey this code will help u since it's collecting Unique values in Listbox,,

Private Sub UserForm_Initialize() Dim cUnique As Collection Dim Rng As Range Dim Cell As Range Dim sh As Worksheet Dim vNum As Variant

Set sh = ThisWorkbook.Sheets("Sheet1") Set Rng = sh.Range("A2", sh.Range("A2").Value ="John". End(xlDown))

Set cUnique = New Collection

On Error Resume Next

For Each Cell In Rng.Cells cUnique.Add Cell.Value, CStr(Cell.Value) Next Cell

On Error GoTo 0

For Each vNum In cUnique Me.ListBox1.AddItem vNum

Next vNum End Sub

answered Apr 10, 2017 at 12:55

community wiki

Rajesh Sinha

1 Comment

Darren Bartrup-Cook Over a year ago

Set Rng = sh.Range("A2", sh.Range("A2").Value ="John". End(xlDown)) won't compile.

Rajesh Sinha · Accepted Answer · 2017-04-10 12:14:30Z

-1

You have not declared Variable Rng & i these are the most important thing to do. Meanwhile I would like to suggest this Formula,,

=Sum(if(Frequency (if(Len(B2 :B20) >0,Match(B2 :B20, B2 :B20, 0),""),if(Len(B2 :B20) >Match(B2 :B20, B2 :B20, 0),"",))>0,1))

Its Array formula so finish with Ctrl +shift +enter.

You can use this one also,

Sub CountUnique()Dim i, count, j As Integer count = 1 For i = 1 To 470 flag = False If count

1 Then For j = 1 To count If Sheet1.Cells(i, 3).Value = Sheet1.Cells(j, 11).Value Then flag = True End If Next j Else flag = False End If If flag = False Then Sheet1.Cells(count, 11 ).Value = Sheet1.Cells(i, 3).Value count = count + 1 End IfNext i Sheet1.Cells( 1 , 15 ).Value = count End Sub

answered Apr 10, 2017 at 12:14

community wiki

Rajesh Sinha

2 Comments

Student of the Digital World Over a year ago

No, I don't think this will work as you haven't added the Condition that is - Starts with "Joh" only

Rajesh Sinha Over a year ago

Sorry it was my fault,, I have not noticed the Criteria, meanwhile you use the Formula, soon I'll be able to get solution.

Collectives™ on Stack Overflow

Excel VBA - Collection error

4 Answers 4

4 Comments

2 Comments

1 Comment

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

4 Comments

2 Comments

1 Comment

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related