Count unique records in a filtered range

Hello jiminic ,

This macro will count only the unique values in the leftmost column of a selected range or the range supplied to it by code.

Function GetUniqueCount(Rng As Range)

   Dim Cell As Range
   Dim Cnt As Long
   Dim DSO As Object
        
    'Use only the first column of the selected range
     Set Rng = Rng.Resize(Rng.Rows.Count, 1)
     
     Set DSO = CreateObject("Scripting.Dictionary")
     DSO.CompareMode = 1
     
       For Each Cell In Rng
         If Cell <> "" Then
           If Not DSO.Exists(Cell.Text) Then
              DSO.Add Cell.Text, Cell
              Cnt = Cnt + 1
           End If
         End If
      Next Cell
    
    Set DSO = Nothing
    GetUniqueCount = Cnt
    
End Function

Sincerely,
Leith Ross