Function to count distinct values in a column range

Question

I am attempting to create a function in VBA that, when given a range of values, will return a Count Distinct of those values. For example:

| Column A | |-----

Answer 1

This method applies the following logic.

• Place the range elements into an array
• Place the array into a dictionary for unique elements only
• Count the elements (keys) in the dictionary for unique elements

Under Tools-->References, Reference "Microsoft Scripting Runtime"

Option Explicit

Dim lngCounter As Long
Dim dataRange As Range
Dim dictTemp As Dictionary
Dim varTemp As Variant

Sub Test()

Set dataRange = Range(Cells(2, 1), Cells(12, 1))

MsgBox CountDistinct(dataRange), vbInformation + vbSystemModal, "Count Distinct"

End Sub

Public Function CountDistinct(dataRange As Range) As Long

'Populate range into array
If dataRange.Rows.Count < 2 Then
    ReDim varTemp(1 To 1, 1 To 1)
    varTemp(1, 1) = dataRange
Else
    varTemp = dataRange
End If

'Dictionaries can be used to store unique keys into memory
Set dictTemp = New Dictionary

'Add array items into dictionary if they do not exist
For lngCounter = LBound(varTemp) To UBound(varTemp)
    If dictTemp.Exists(varTemp(lngCounter, 1)) = False Then
        dictTemp.Add Key:=varTemp(lngCounter, 1), Item:=1
    End If
Next lngCounter

'Count of unique items in dictionary
CountDistinct = dictTemp.Count

End Function