Function Count Unique Visible Cells

[willastrowalker]

Hello,

I am trying to count unique cells in a filtered list. The macro I have to count total unique cells seems to work perfectly. but i'm trying to change it in two ways.. First is to have it count the unique cells that are not filtered/visible (visibility is set my filters, not group & hide).

the next way i'm trying to do it it to make it a countuniqueif function.. eg, =Countuniqueif(a1:a100,b1:b100,"Countme") - column A has potentially unique values, column B has the "Countme" tag.

Any ideas on either would be a huge help!

thanks

Function CountUnique(ListRange As Range) As Integer


    Dim CellValue As Variant
    Dim UniqueValues As New Collection


    Application.Volatile


    On Error Resume Next


    For Each CellValue In ListRange
              
        UniqueValues.Add CellValue, CStr(CellValue) ' add the unique item
            
    Next


    CountUnique = UniqueValues.Count


End Function

 

[shg]

Untested:

Function CountUnique(rList As Range, rTag As Range, sTag As String) As Long
  Dim col           As Collection
  Dim cell          As Variant
  Dim i             As Long

  Set col = New Collection

  On Error Resume Next
  For i = 1 To rList.Rows.Count
    If rTag(i, 1).Value = sTag Then
      If Not Rows(rList(i, 1)).Row.Hidden Then
        col.Add Item:=0, Key:=rList(i, 1).Text
      End If
    End If
  Next i

  CountUnique = col.Count
End Function

 

[willastrowalker]

That doesn't work..

Was thinking something like this (but it still doesn't work.. I think I need to redefine the Listrange range to only show the visible cells?

Function CountUnique(ListRange As Range) As Integer


    Dim CellValue As Variant
    Dim UniqueValues As New Collection


    Application.Volatile
    Set ListRange = ListRange.SpecialCells(xlCellTypeVisible)


    On Error Resume Next
          
    For Each CellValue In ListRange
              
        UniqueValues.Add CellValue, CStr(CellValue) ' add the unique item
            
    Next


    CountUnique = UniqueValues.Count


End Function

 

[shg]

Typo; the line should be

If Not Rows(rList(i, 1).Row).Hidden Then