Count unique records in a filtered range

Is it possible to count the unique entries in a range based on the results of a filter that has been applied? I basically have a column with 2000+ cells that contain some matching values and I only want to count the unique entries. This will need to be a dynamic count as well as the filter criteria can and will change all the time.

Any help would be appreciated!

Hello jiminic,

What filter are you applying to the data? Is it filtered in place?

Sincerely,
Leith Ross

Hi Leith

The filtering is done through the Data/Filter/Autofilter function and will either be "MDp", "XML" or none. I am unsure of what you mean by "will it be filtered in place"

Thank you

Hello jiminic,

Here is macro that will return the row count for a range after it has been filtered.

Function GetUniqueCount(Rng As Range) As Long

  Dim Cnt As Long
  Dim RA As Variant
    
    On Error Resume Next
      Set Rng = Rng.SpecialCells(xlCellTypeVisible)
      If Err = 0 Then
        For Each RA In Rng.Areas
          Cnt = Cnt + RA.Rows.Count
        Next RA
      Else
         Err.Clear
         On Error GoTo 0
      End If
    
    GetUniqueCount = Cnt
    
End Function

Sincerely,
Leith Ross

Thank you Leith, how do I make this work though? I can not find the macro name in the list to apply it to a button.

Hello jiminic,

The only macros that show up in the Macro List (ALT+F8) are Functions and Subs which don't take arguments. This Sub requires a Range Argument and must be run from within VBA. It cannot be converted to a Function and used as a UDF because Excel will always return the count of all rows in the given range, and not just the filtered ones. It would help to see your workbook.

Sincerely,
Leith Ross

Thanks Leith, I have that part figured out now.

One more question though, I have been using the following formula

=SUBTOTAL(3,D3:D1229)

, but once again, this returns a complete count for the range. Is there anyway you know of that I can apply count unique entries only to this formula?

There are many passwords and protection on my workbook, so it would be difficult to show it to you.

As an example, the data that would be filtered would be as follows:

XXSONRP MDp
PRRTH1RP MDp
DRRRP XML
RORP XML
PROAR1RP MDp
XXSONRP MDp
RACTRP XML
RACTRP XML
XXSONRP MDp
RERP XML
CERP XML
DERP XML
PYRIZ1RP MDp
PYRID1RP MDp
PRDPZ1RP MDp
PRDPC1RP MDp
CURLB1RP MDp
PRRIS1RP MDp
PRUIS1RP MDp
XXSONRP MDp
SPRRP XML
CURSH1RP MDp
ADSCU1RP MDp
XXSONRP MDp
CT XML
CT XML
PRREH1RP MDp
PRRPH1RP MDp
PROAR1RP MDp
XXSONRP MDp
XXSONRP MDp
SPRRP XML
CURSH1RP MDp

To clear things up, I am actually filtering by the MDp/XML column, but want to base the count of unique values on the column containing XXSONRP.

I hope this is of use!

Hello jiminic,

In your last post, is the data in 2 columns or just one? Will the data always be starting in row 3? Are the "MDp" and "XML" portions to be considered when testing for uniqueness?

Sincerely,
Leith Ross

Hi Leith

I really appreciate your help with this one.

The data is in 2 columns, and yes the data will always be starting in row 3. The "MDp" and "XML" portions are not to be considered when testing for uniqueness, only the actual data in row 1.

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

Thank you Leith, you help has been invaluable!

Hello jiminic,

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save

Sincerely,
Leith Ross

Hi Leith, can I ask one more question please?

Does having blanks in the range affect the results? I only ask as if I filter by XML in column 2, there are 40 results in column 1 with 14 unique records, but the function you helped me with returns a result of 124?

Thanks once again

Hello jiminic,

The macro ignores cells that are blank. If a cell contains one or more spaces, it is not considered blank. I have updated the macro to ignore cells that may contain only spaces.

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 Trim(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