Unique Count (Excel VBA vs Formulas) Faster Approa

Question

32 Bit Excel 365 on 64 Bit Win7 Worksheet 300600 Rows x 105 Columns Goal: Calculate the Number of Unique Entries in each Column

Attempted Solution 1: Formula

{=SUM(1/COUNTIF(A8:A300600,A8:A300600))}

Issue: Long Runtime, Freezes Excel, Must Stop Calculation

Attempted Solution 2: VBA UDF

Function UniqueCount(Selection As Range) As Integer
Dim UniqueArray()
ReDim UniqueArray(0 To Selection.Count)
Dim Rng As Range
Dim CUniqueCount As Integer
CUniqueCount = 0
For Each Rng In Selection
    For i = 0 To Selection.Count
        If UniqueArray(i) = Rng.Value Then Exit For
        If UniqueArray(i) = "" Then
            UniqueArray(i) = Rng.Value
            CUniqueCount = CUniqueCount + 1
            Exit For
        End If
    Next i
Next
UniqueCount = CUniqueCount
End Function

Note: This is Much faster, but I'm still looking for an even faster approach

Answer 1

Try this

'Set a reference to MS Scripting runtime ('Microsoft Scripting Runtime')
Function UniqueCount(SelRange As Range)
    Dim Rng As Range
    Dim dict As New Scripting.Dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    For Each Rng In SelRange
        If Not dict.Exists(Rng.Value) Then
            dict.Add Rng.Value, 0
        End If
    Next Rng
    UniqueCount = dict.Count
    Set dict = Nothing
End Function

Answer 2

I'd use an array as well as the Dictionary:

Public Function CountUnique(rngInput As Range) As Double
    Dim rngCell               As Range
    Dim dData                 As Object
    Dim vData
    Dim x                     As Long
    Dim y                     As Long

    Set dData = CreateObject("Scripting.Dictionary")

    vData = rngInput.Value2
    For x = LBound(vData, 1) To UBound(vData, 1)
        For y = LBound(vData, 2) To UBound(vData, 2)
            If LenB(vData(x, y)) <> 0 Then dData(CStr(vData(x, y))) = Empty
        Next y
    Next x
    CountUnique = dData.Count
End Function