Function To Get The Unique Count In A Range

1 minute read

User Defined Function to get the unique count in a range.

'   This is an Ultra-fast UDF to use in Excel or VBA to derive a Unique Count from a Range.
'   The Code works by building a Dictionary of the Unique values. You can pass the Range as
'   a Worksheet Range or a Defined Name. An example of using the UDF in Excel would be
'   ="Unique SKUS in this Report: "&TEXT(CountUnique($B$9:$B$81880),"#,##0") or ="Unique SKUS
'   in this Report: "&TEXT(CountUnique(FilteredRange),"#,##0"). Don't believe how fast this is? ...
'   then try it for yourself. I use this on over 100,000 Rows of data and even when using the
'   AutoFilter it is still instant:

Public Function CountUnique(CellRange As Range) As Long
    On Error Resume Next

    ' you can choose to set or not set this.  if you set it, then it will fire on event handlers for Cell Selections etc.
    ' Application.Volatile

    '  turn off Screen drawing
    Application.ScreenUpdating = False

    ' Vars
    Dim lngY As Long
    Dim vntData As Variant
    '  use late binding.  uncomment the Dictionary & New Dictionary to use early binding
    Dim objDictionary As Object 'Dictionary

    ' initialise the Dictionary
    Set objDictionary = CreateObject("Scripting.Dictionary") 'New Dictionary
    objDictionary.CompareMode = BinaryCompare

    ' pickup all of the data to perform the Count
    vntData = CellRange

    ' build the Unique Count
    For lngY = 1 To UBound(vntData)
        If vntData(lngY, 1) <> "" And Not objDictionary.Exists(vntData(lngY, 1)) Then
            objDictionary.Add vntData(lngY, 1), 1
        End If
    Next lngY

    ' return the Count
    CountUnique = objDictionary.Count

    ' clean up
    Set objDictionary = Nothing
    Erase vntData

End Function