Excel VBA to count and print distinct values

Question

I have to count number of distinct values from a column and print it with the distinct value and count in another sheet. I am working with this piece of code, but for some reason, it is not returning any result. Could anyone tell me where I am missing the piece!

Dim rngData As Range
Dim rngCell As Range
Dim colWords As Collection
Dim vntWord As Variant
Dim Sh As Worksheet
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet

On Error Resume Next

Set Sh1 = Worksheets("A")
Set Sh2 = Worksheets("B")
Set Sh3 = Worksheets("C")

Sh1.Range("A2:B650000").Delete

Set Sh = Worksheets("A")
Set r = Sh.AutoFilter.Range
r.AutoFilter Field:=24
r.AutoFilter Field:=24, Criteria1:="My Criteria"

Sh1.Range("A2:B650000").Delete

Set colWords = New Collection

Dim lRow1 As Long
lRow1 = <some number>

Set rngData = <desired range>
For Each rngCell In rngData.Cells
    colWords.Add colWords.Count + 1, rngCell.Value
    With Sh1.Cells(1 + colWords(rngCell.Value), 1)
        .Value = rngCell.Value
        .Offset(0, 1) = .Offset(0, 1) + 1
    End With
Next

Above is my full code.. My required outcome is simple, count number of occurrences of each cell in a column, and print it in another sheet with the count of occurrences. Thanks!

Thanks! Navs.

your code is somehow weird. As brettdj said, post your full code and explain us what you expected from your code — JMax
– JMax, Commented Mar 12, 2012 at 9:24
There are still numerous problems with the code; variables not declared, others that are not used. It looks very much like a extract from a larger piece. — Lunatik
– Lunatik, Commented Mar 12, 2012 at 11:00
>>>"it is not returning any result. Could anyone tell me where I am missing the piece!": What happens when you remove On Error Resume Next — Siddharth Rout
– Siddharth Rout, Commented Mar 12, 2012 at 14:35

Gaijinhunter · Accepted Answer · 2013-08-13 22:03:42Z

9

This is extreamlly easy and practical to do using a dictionary object. The logic is similar to Kittoes answer, but the dictionary object is much faster, effecient, and you can output an array of all keys and items, which you want to do here. I have simplified the code to generating a list from column A, but you will get the idea.

Sub UniqueReport()

Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim varray As Variant, element As Variant

varray = Range("A1:A10").Value

'Generate unique list and count
For Each element In varray
    If dict.exists(element) Then
        dict.Item(element) = dict.Item(element) + 1
    Else
        dict.Add element, 1
    End If
Next

'Paste report somewhere
Sheet2.Range("A1").Resize(dict.Count, 1).Value = _
    WorksheetFunction.Transpose(dict.keys)
Sheet2.Range("B1").Resize(dict.Count, 1).Value = _
    WorksheetFunction.Transpose(dict.items)

End Sub

How it works: You just dump the range into a variant array to loop through quickly, then add each to the dictionary. If it exists, you just take the item that goes with they key (starts at 1) and add one to it. Then at the end just slap the unique list and the counts wherever you need them. Please note that the way I create an object for the dictionary allows anyone to use it - there is no need to add a reference to your code.

edited Aug 13, 2013 at 22:03

answered Mar 13, 2012 at 5:44

Gaijinhunter

14.7k4 gold badges53 silver badges58 bronze badges

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

5 Comments

Kittoes0124 Over a year ago

@user1087661: I agree with Issun that the dictionary obect would be the better option. I only went the Array route because I figured you might be more comfortable with it.

GeoffDS Over a year ago

Awesome. I am not an expert programmer, but I have used Python and knew about dictionaries. But, I did not know they existed in VBA!

Gaijinhunter Over a year ago

Please note the scripting dictionary object is only available to Windows users - you can't use this on a Mac, unfortunately... :(

Vignesh Subramanian Over a year ago

how can i select an entire column?

Gaijinhunter Over a year ago

just change to varray = Range("A:A").Value

Kittoes0124 · Accepted Answer · 2012-03-13 03:50:59Z

Not the prettiest or most optimum route but it'll get the job done and I'm pretty sure you can understand it:

Option Explicit

Sub TestCount()

Dim rngCell As Range
Dim arrWords() As String, arrCounts() As Integer
Dim bExists As Boolean
Dim i As Integer, j As Integer

ReDim arrWords(0)

For Each rngCell In ThisWorkbook.Sheets("Sheet1").Range("A1:A20")
    bExists = False

    If rngCell <> "" Then
        For i = 0 To UBound(arrWords)
            If arrWords(i) = rngCell.Value Then
                bExists = True
                arrCounts(i) = arrCounts(i) + 1
            End If
        Next i

        If bExists = False Then
            ReDim Preserve arrWords(j)
            ReDim Preserve arrCounts(j)

            arrWords(j) = rngCell.Value
            arrCounts(j) = 1

            j = j + 1
        End If
    End If
Next

For i = LBound(arrWords) To UBound(arrWords)
    Debug.Print arrWords(i) & ", " & arrCounts(i)
Next i

End Sub

This will loop through A1:A20 on "Sheet1". If the cell is not blank it will check to see if the word exists in the array. If not then it adds it to the array with a count of 1. If it does exist then it simply adds 1 to the count. I hope this suits your needs.

Also, just something to keep in mind after glancing at your code: you should virtually NEVER use On Error Resume Next.

Collectives™ on Stack Overflow

Excel VBA to count and print distinct values

2 Answers 2

5 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

5 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related