Need to Count unique items in a column with VBA

MikeJP · May 9, 2003

I need to count the number of unique items in a column (excluding blank cells if possible) in VBA. I want to use the number as follows:

For x = 1 to (number of unique items)

To control how many times I pass through a loop.

Thanks
Mike Piles

NateO · May 9, 2003

Howdy Mike,

Not sure about the tack-on loop, but you can use the TotUni long integer returned by the following which should respresent the count of unique items in your column of choice:

Sub CntUnique()
Dim Uni As Collection, cl As Range, LpRange As Range
Dim clswfrm As Range, clswcst As Range, myRng As Range
Dim TotUni As Long
'*************
Set myRng = Sheets(1).[a:a] 'define your sheet/range
'*************
On Error Resume Next
Set clswfrm = myRng.SpecialCells(xlFormulas)
Set clswcst = myRng.SpecialCells(xlConstants)
Set myRng = Nothing 'free up memory
On Error GoTo 0
If clswfrm Is Nothing And clswcst Is Nothing Then
 MsgBox "No Unique Cells"
 Exit Sub
 ElseIf Not clswfrm Is Nothing And Not clswcst Is Nothing Then
 Set LpRange = Union(clswcst, clswfrm)
 ElseIf clswfrm Is Nothing Then Set LpRange = clswcst
 Else: Set LpRange = clswfrm
End If
Set clswfrm = Nothing: Set clswcst = Nothing 'Free up memory
Set Uni = New Collection
On Error Resume Next
For Each cl In LpRange
 Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string
Next cl
On Error GoTo 0
Set LpRange = Nothing 'free up memory
TotUni = Uni.Count
Set Uni = Nothing ''free up memory
MsgBox TotUni 'Work with the Unique value total here (replace msgbox)
End Sub


The proc. may seem a little long, however, I didn't think looping through 65536 cells in a column is a good approach. The initial part of procedure is determining your range in the column that actually holds either cell constants or formulae, which gets us around evaluating blank cells.

Hope this helps.

MikeJP · May 9, 2003

THanks Nate,

Works great!!! It was a little more complex than I expected!

Regards,
Mike

Juan Pablo González · May 9, 2003

Another option is a function like this:


Function CountUnique(ByVal Rng As Range) As Long
 Dim St As String
 Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
 St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
 CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function


You could use it like

MsgBox CountUnique(Sheets("Sheet1").Range("A:A"))

countingapples · Mar 22, 2004

I'm needing to do a similar task, but from a pivot table looking at a column of text. My original thread is below.

http://www.mrexcel.com/board2/viewtopic.php?t=81625&highlight=

I just want to have this piece:

Code:

' This creates the data fields.
    With ActiveSheet.PivotTables("Unit Response Summary").PivotFields( _
        "Incident Type Class")
        .Orientation = xlDataField
        .Position = 1
        .Caption = "Count"
        '.Function = CountUnique(Sheets("PersonnelResponseData").Range("U:U")) **tried JP's here** 
        .NumberFormat = "#,##0"
    End With

perform the count of unique items.

Thanks,
CountingApples

NateO · Mar 22, 2004

To create a unique list? Use the advanced filter. Or to count, use the original data set.

countingapples · Mar 22, 2004

Put my original data where? Sorry for being dense, I've been trying so many different variations of countif and the two macros here I can't think straight anymore.

NateO · Mar 22, 2004

Change:

Set myRng = Sheets(1).[a:a] 'define your sheet/range

To your original data set (pre P.T.).

countingapples · Mar 23, 2004

I have that in and it keeps telling me that there are no unique items. I expect a minimum of 8 items. Just for kicks I tried using the incident number rather than incident category and that had no unique items either. I'm looking at the data in sheet 2.

Any thoughts on what I've done wrong, or where I should look?

NateO · Mar 23, 2004

I don't know what you've done or what you're looking at based on your posts.

If I want to look at a:d on sheets(2), the constants and functions, the following works as expected for me:

Sub CntUnique2()
Dim Uni As Collection, cl As Range, LpRange As Range
Dim clswfrm As Range, clswcst As Range, myRng As Range
Dim TotUni As Long
'*************
Set myRng = Sheets(2).[a:d] 'define your sheet/range
'*************
On Error Resume Next
Set clswfrm = myRng.SpecialCells(xlFormulas)
Set clswcst = myRng.SpecialCells(xlConstants)
Set myRng = Nothing 'free up memory
On Error GoTo 0
If clswfrm Is Nothing And clswcst Is Nothing Then
 MsgBox "No Unique Cells"
 Exit Sub
 ElseIf Not clswfrm Is Nothing And Not clswcst Is Nothing Then
 Set LpRange = Union(clswcst, clswfrm)
 ElseIf clswfrm Is Nothing Then Set LpRange = clswcst
 Else: Set LpRange = clswfrm
End If
Set clswfrm = Nothing: Set clswcst = Nothing 'Free up memory
Set Uni = New Collection
On Error Resume Next
For Each cl In LpRange
 Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string
Next cl
On Error GoTo 0
Set LpRange = Nothing 'free up memory
TotUni = Uni.Count
Set Uni = Nothing ''free up memory
MsgBox TotUni 'Work with the Unique value total here (replace msgbox)
End Sub

Need to Count unique items in a column with VBA

MikeJP

Board Regular

Excel Facts

NateO

Legend

MikeJP

Board Regular

Juan Pablo González

MrExcel MVP

countingapples

Board Regular

NateO

Legend

countingapples

Board Regular

NateO

Legend

countingapples

Board Regular

NateO

Legend

Similar threads

Forum statistics

Share this page

Need to Count unique items in a column with VBA

Board Regular

Excel Facts

Legend

Board Regular

MrExcel MVP

Board Regular

Legend

Board Regular

Legend

Board Regular

Legend

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock