count unique

[jebenexcel]

Hi,
I found a user defined function that counts unique entries in a range. Why does it output 0 for me?

Function COUNTUNIQUE(DataRange As Range, CountBlanks As Boolean) As Integer
Dim CellContent As Variant
Dim UniqueValues As New Collection
Application.Volatile
On Error Resume Next
For Each CellContent In DataRange
If CountBlanks = True Or IsEmpty(CellContent) = False Then
UniqueValues.Add CellContent, CStr(CellContent)
End If
Next
COUNTUNIQUE = UniqueValues.Count
End Function

 

[Yongle]

I have tested the function and it works correctly

Do this to satisfy yourself that it works:
- create a NEW workbook
- place some values (including blanks) in A1 to A20
- paste the UDF code into a standard module in that workbook
- put this formula in cell B1
=countunique(A1:A20,TRUE)

If it still is not working, then let me know

 

[jebenexcel]

Is there a limit on how many entries it can count?

It counts fine if there's 20, 200, 2000 entries, but when i try to use it on my 200k entry sample it returns a 0.

 

[Yongle]

It would have been helpful if you had mentioned that "extra" detail earlier

I have tested again and the function tops out at 32767 unique values
- there appears to be an upper a limit on the number of "keys" in a collection

I cannot immediately think of a quick fix for you
- the trick in the function (which makes it efficient) is that duplicate values are rejected from being added to the collection by using the fact that collection "keys" cannot be duplicated.

 

[Fluff]

Make this change

Function COUNTUNIQUE(DataRange As Range, CountBlanks As Boolean) As [COLOR=#ff0000]Long[/COLOR]

 

[Yongle]

@Fluff -well spotted
@jebenexcel - here is a different way
You need to add a reference to Mircrosoft Scripting Runtime
(In VBA window click Tools \ References \ scroll down to Mircrosoft Sripting Runtime\ check the box \ OK)

Function CountUnique2(Rng As Range) As Long
    Dim dict As Dictionary, cell As Range
    Set dict = New Dictionary
    For Each cell In Rng.Cells
        If Not dict.Exists(cell.Value) Then dict.Add cell.Value, 0
    Next
    CountUnique2 = dict.Count
End Function

 

[Fluff]

Or without needing a reference

Function CountUnique2(Rng As Range) As Long
    Dim dict As Object, cell As Range
    Set dict = CreateObject("scripting.dictionary")
    For Each cell In Rng.Cells
        If Not dict.Exists(cell.Value) Then dict.Add cell.Value, 0
    Next
    CountUnique2 = dict.count
End Function

 

[Yongle]

@Fluff
- that does avoid adding reference
- but is 20% slower (on my PC)

Whilst testing that, I also tested the original function - that was the fastest of all!