Display a count for each unique value in a table column

Question

How can I grab a count of each unique value from a table's column, plus the actual value, into another cell.

Table 1's status column

**status**  
------  
itemA
itemA
itemB
itemC

desired results into a single cell:

Table 1 Status summary |2 itemA, 1 itemB, 1 itemC

I would settle for a simple comma separated list of all the distinct values without the count.

BACKGROUND INFO: I have an excel document we are using to keep track of acceptance testing of a new application. The document which holds multiple worksheets (each representing an area of code that needs to be tested) and each worksheet has multiple tables (which represent test cases where each case should be tested multiple times or in different ways etc.) and then there is a summary worksheet where I want a snap shot of the data. On the summary page there is line for each table in each worksheet and a status column. In that status column I want to display a count of each status selected in the corresponding table. I had originally created a lengthy formula that hard coded the values and their counts if count was > 0, but as we are testing we are finding the need to add new status values and the formula then becomes way to burdensome to keep updated.

EDIT: ADDING FORMULA Here is the formula that I originally had in there

=IF(COUNTIF(Table1[Status],"itemA"),COUNTIF(Table1[Status],"itemA")&" itemA"," ") & IF(COUNTIF(Table1[Status],"itemB"), ", " &COUNTIF(Table1[Status],"itemB")&" itemB"," ") & IF(COUNTIF(Table1[Status],"itemC"), ", " &COUNTIF(Table1[Status],"itemC")&" itemC"," ")

The problem with this is, the formula was repeated about 100 times on the summary page (once for each table in the underlying worksheets) and every time I wanted to add a status I would need to edit each of the formulas.

Answer 1

If your cells are in A1:A4, put this array formula in cells B1:B4:

{=$A$1:$A$4&": "&COUNTIF($A$1:$A$4,$A$1:$A$4)}

This will create your strings which look like itemA: 2 and itemB: 1, but there will be repetitions.

Then, you'd use the VBA code you suggested in the comments. I'm putting it here for the sake of completeness:

Function ConcatUniq(ByRef rng As Range) As String
    Dim r As Range
    Static dic As Object
    If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
    For Each r In rng
        If r.Value <> Empty Then
            dic(r.Value) = Empty
        End If
    Next
    ConcatUniq = Join$(dic.keys, ", ")
    dic.RemoveAll
End Function

So your final string's cell formula will look like this:

=ConcatUniq(B1:B4)

Answer 2

This VBA solution uses an User Defined Function which:

.- Validates the Target Range belongs to a ListObject (Excel Table).

.- Uses an Array to hold all Status values from the table.

.- Uses a Control string to validate uniqueness Status.

.- Uses an Output string to hold the list of unique Status with the corresponding count.

Note: The list will have the same order as they appear in the table. Sort is not on the scope of the question but if you want it sorted I suggest to sort the ListObject as required (not included).

Try this procedure (see comments included in the code):

Private Function Lob_Status_Count(rTrg As Range) As String
Const kStt As String = "Status"
Dim lob As ListObject
Dim sControl As String, sOutput As String
Dim aStt As Variant, vStt As Variant, bStt As Byte
    Rem Validate Input
    On Error Resume Next
    Set lob = rTrg.ListObject               'Set ListObject
    On Error GoTo 0
    If lob Is Nothing Then GoTo ExitTkn     'Exit if Target range is not a ListObject

    With lob.ListColumns(kStt).DataBodyRange

        Rem Set Status Array
        aStt = WorksheetFunction.Transpose(.Value2)

        Rem Set Status Output
        For Each vStt In aStt
            If InStr(sControl, Chr(167) & vStt & Chr(167)) = 0 Then     'Validates uniqueness
                bStt = WorksheetFunction.CountIf(.Cells, vStt)          'Gets Status Count
                sOutput = sOutput & ", " & bStt & " " & vStt            'Adds to Results
                sControl = sControl & Chr(167) & vStt & Chr(167)        'Adds to Control
        End If: Next

        Rem Cleanup Output
        sOutput = Replace(sOutput, ", ", vbNullString, 1, 1)

    End With

    Rem Set Results
    Lob_Status_Count = sOutput

Exit Function
ExitTkn:
    Lob_Status_Count = "!Err ListObject"

End Function

Suggest to read the following pages to gain a deeper understanding of the resources used:

Using Arrays, ListObject Members (Excel), WorksheetFunction Object (Excel),

For Each...Next Statement, InStr Function, On Error Statement.