Count a column "unique value only"

[Galway]

Is there a way to count the cell in a column, by unique value only.
I have a column with names of people.
There are only 10 names over 400 rows.

 

[RadarEye]

Is there a way to count the cell in a column, by unique value only.
I have a column with names of people.
There are only 10 names over 400 rows.

Hi Galway,

If you know all the 10 names try:

=CountIf(Range(),"A Name")

eg:

A
1 Abe
2 Bert
3 Charlie
4 Dirk
5 Edward
6 Abe
7 Charlie

For B1: =COUNTIF(A1:A7,"Abe") the result will be 2


HTH

 

[Bob Phillips]

=SUMPRODUCT((A2:A200<>"")/COUNTIF(A2:A200,A2:A200&""))

 

[Galway]

Hi Galway,

If you know all the 10 names try:

=CountIf(Range(),"A Name")

eg:

    A
1  Abe
2  Bert
3  Charlie
4  Dirk
5  Edward
6  Abe
7  Charlie

For B1: =COUNTIF(A1:A7,"Abe") the result will be 2

HTH

Thank you so far..however
What if you do not know the names?
Galway

 

[RadarEye]

Thank you so far..however
What if you do not know the names?
Galway- Tekst uit oorspronkelijk bericht niet weergeven -

- Tekst uit oorspronkelijk bericht weergeven -

Hi Galway,

If you do not know the names, and you dont want to mesh up your sheet
try this macro:

'-----------------Start
Public Sub CountUniqueValues()
ReDim strNames(0) As String
ReDim intCount(0) As Long
Dim lngLastRow As Long
Dim lngUniqueNames As Long
Dim rngSingle As Range
Dim intLastUnique As Integer
Dim intLoopUnique As Integer
Dim blnNotFound As Boolean
Dim strMessage As String

intLastUnique = -1
lngLastRow = Cells(1, 1).End(xlDown).Row
For Each rngSingle In Range(Cells(1, 1), Cells(lngLastRow,
1)).Cells
blnNotFound = True
If intLastUnique = -1 Then
strNames(0) = rngSingle.Value
intCount(0) = 1
intLastUnique = 0
Else
For intLoopUnique = 0 To intLastUnique
If strNames(intLoopUnique) = rngSingle.Value Then
intCount(intLoopUnique) = intCount(intLoopUnique)
+ 1
blnNotFound = False
Exit For
End If
Next
If blnNotFound Then
intLastUnique = intLastUnique + 1
ReDim Preserve strNames(intLastUnique) As String
ReDim Preserve intCount(intLastUnique) As Long
strNames(intLastUnique) = rngSingle.Value
intCount(intLastUnique) = 1
End If
End If
Next

strMessage = "Names" & vbTab & "Number" & vbNewLine
For intLoopUnique = 0 To intLastUnique
strMessage = strMessage & strNames(intLoopUnique) & _
vbTab & intCount(intLoopUnique) &
vbNewLine
Next
MsgBox strMessage
End Sub
'------------END

 

[Galway]

HiGalway,

If you do not know the names, and you dont want to mesh up your sheet
try this macro:

'-----------------Start
Public Sub CountUniqueValues()
    ReDim strNames(0) As String
    ReDim intCount(0) As Long
    Dim lngLastRow      As Long
    Dim lngUniqueNames  As Long
    Dim rngSingle       As Range
    Dim intLastUnique   As Integer
    Dim intLoopUnique   As Integer
    Dim blnNotFound     As Boolean
    Dim strMessage      As String

    intLastUnique = -1
    lngLastRow = Cells(1, 1).End(xlDown).Row
    For Each rngSingle In Range(Cells(1, 1), Cells(lngLastRow,
1)).Cells
        blnNotFound = True
        If intLastUnique = -1 Then
            strNames(0) = rngSingle.Value
            intCount(0) = 1
            intLastUnique = 0
        Else
            For intLoopUnique = 0 To intLastUnique
                If strNames(intLoopUnique) = rngSingle.Value Then
                    intCount(intLoopUnique) = intCount(intLoopUnique)
+ 1
                    blnNotFound = False
                    Exit For
                End If
            Next
            If blnNotFound Then
                intLastUnique = intLastUnique + 1
                ReDim Preserve strNames(intLastUnique) AsString
                ReDim Preserve intCount(intLastUnique) AsLong
                strNames(intLastUnique) = rngSingle.Value
                intCount(intLastUnique) = 1
            End If
        End If
    Next

    strMessage = "Names" & vbTab & "Number" & vbNewLine
    For intLoopUnique = 0 To intLastUnique
        strMessage = strMessage & strNames(intLoopUnique) & _
                             vbTab & intCount(intLoopUnique) &
vbNewLine
    Next
    MsgBox strMessage
End Sub
'------------END- Hide quoted text -

- Show quoted text -

Thanks!