Count Unique Cells Hi there I have a worksheet with cells A1:CB2786 containing e

Question

Count Unique Cells

Hi there

I have a worksheet with cells A1:CB2786 containing either:

Text

Numbers

Blank

Text and Numbers

I need to be able to count the number of cells containing Unique Content in any form (excluding blanks)

For example, 5 different cells containing:

7

17

seven

sevens

seven

would total 4 cells with unique content...

I was kindly provided with the below as a solution, however when I run it, it takes 15-20 minutes to return a result and sometimes does not return a result at all., during which time I cannot use the sheet.

=SUMPRODUCT((A4:CB3000<>"")/COUNTIF(A4:CB3000,A4:CB3000&""))

I'd be incredibly grateful if someone had a solution out there!!

Thank for help !!

Explanation / Answer

Hi..

Copy the following custom function into a module in the Visual Basic Editor:

Function CountUnique(r As Range) As Long
    Dim typ As Variant
    Dim rng As Range
    Dim cel As Range
    Dim col As New Collection
    Dim v As Variant
    On Error Resume Next
    For Each typ In Array(xlCellTypeConstants, xlCellTypeFormulas)
        Set rng = Nothing
        Set rng = r.SpecialCells(typ)
        If Not rng Is Nothing Then
            For Each cel In rng
                If Not IsError(cel.Value) Then
                    v = cel.Value
                    If v <> "" Then
                        col.Add Item:=v, Key:=CStr(v)
                    End If
                End If
            Next cel
        End If
    Next typ
    CountUnique = col.Count
End Function

Use the following formula:

= CountUnique(A4:CB3000)

It takes about 1 second on my PC with some test data in A4:CB3000.

or

try

Any formula to calculate unique values in that many cells is going to be very slow so I suggest a UDF.

ALT+F11 to open VB editor, right click 'ThisWorkbook' and insert module and paste the code below in. Close VB editor.

Back on the worksheet call with

=CountUnique(A4:CB3000)

Function CountUnique(rng As Range) As Long
Application.Volatile
Dim MyCollection As New Collection
Dim c As Range
On Error Resume Next
For Each c In rng
If c <> "" Then
    MyCollection.Add Item:=CStr(c.Value), Key:=CStr(c.Value)
End If
Next c
CountUnique = MyCollection.Count
End Function

Related Questions

Navigate

• Browse (All)
• Browse C
• Subjects