How to count and total items in a column/sheet

Question

I am running osx 10.9 and Excel:Mac2011. I have need to count how many of each item I have in an Excel spreadsheet.

For example:

Cat
Fish
Cat
Dog
Cat
Dog

I'm trying to get some output that would look like this

Cat    Cat =3
Fish   Dog =2
Cat    Fish =1
Dog
Cat
Dog

the output does not need to be sorted/ordered. First come first counted/listed is fine, but i can sort the data if it needs to be.(or makes it easier)

If there is any more information I can provide to help you help me please let me know.

Answer 1

You could loop through all the sheets creating a pivot table for each one, and then copy and paste the data from each pivot table, back onto the source sheet. It's a weird way of doing it, but it will work. Here is the code:

Option Explicit
Sub PivotTableCreator()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False 'Done so excel will delete the pivot table sheet without displaying a messagebox asking you if you are sure
    Dim i, WSCount, LastRow As Long
    WSCount = ActiveWorkbook.Worksheets.Count
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    For i = 1 To WSCount
        Worksheets(i).Activate
        LastRow = Range("A1000000").End(xlUp).Row
        Debug.Print LastRow
        Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, Range("A1", "A" & LastRow)) 'data from column A is used to create the pivot table
        Worksheets.Add 'new worksheet created for pivottable
        Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, TableDestination:=Range("A1"))
        With PT
            .PivotFields("Animals").Orientation = xlRowField 'Place whatever column A's header is here (Animals is a placeholder)
            .PivotFields("Animals").Orientation = xlDataField
            .DisplayFieldCaptions = False
        End With
        ActiveCell.CurrentRegion.Copy
        Worksheets(ActiveSheet.Index + 1).Range("B2").PasteSpecial Paste:=xlPasteValues 'Paste results where you want to, I use B2 in this example
        ActiveSheet.Delete 'No longer need the pivot table, so this sheet is deleted
        Next
End Sub

Answer 2

First and simplest, if you know that there aren't many different values in the column, you could just use countif():

=COUNTIF(A1:A6, "Cat")

Otherwise, if you've got tons of different items in a column and you want an automated solution, a VBA routine that scans the column, tallies the counts of each item, and deposits those counts in other columns seems reasonable.

Sub CountAll()
    Dim searchCol, itemsCol, countCol, sheetName As String
    Dim i, j, startRow As Integer
    Dim aCounts() As Variant
    Dim bAdded, bFound As Boolean

    startRow = 1
    searchCol = "A"
    itemsCol = "B"
    countCol = "C"
    sheetName = "Sheet1"

    ReDim aCounts(2, 1)

    With Sheets(sheetName)
        For i = 1 To .Range(searchCol & startRow).End(xlDown).Row
            For j = 1 To UBound(aCounts, 2)
                If (.Range(searchCol & i).Value) = aCounts(0, j) Then
                    bFound = True
                    Exit For
                Else
                    bFound = False
                End If
            Next
            If (bFound) Then
                aCounts(1, j) = aCounts(1, j) + 1
            Else
                If (aCounts(1, UBound(aCounts, 2)) <> "") Then
                    ReDim Preserve aCounts(2, UBound(aCounts, 2) + 1)
                End If
                aCounts(0, UBound(aCounts, 2)) = .Range(searchCol & i).Value
                aCounts(1, UBound(aCounts, 2)) = 1
            End If
        Next

        i = 1
        For i = 1 To UBound(aCounts, 2)
            .Range(itemsCol & i).Value = aCounts(0, i)
            .Range(countCol & i).Value = aCounts(1, i)
        Next
    End With
End Sub

If all your sheets are similar and you want it to run on each sheet, just change the With Sheets(sheetName) to For Each Sheet in Sheets, change End With to Next, add Sheet before each .Range, and reset the array with each iteration:

For Each Sheet In Sheets()
    ReDim aCounts(2, 1)
    For i = 1 To Sheet.Range(searchCol & startRow).End(xlDown).Row
        For j = 1 To UBound(aCounts, 2)
            If (Sheet.Range(searchCol & i).Value) = aCounts(0, j) Then
                bFound = True
                Exit For
            Else
                bFound = False

            End If
        Next
        If (bFound) Then
            aCounts(1, j) = aCounts(1, j) + 1
        Else
            If (aCounts(1, UBound(aCounts, 2)) <> "") Then
                ReDim Preserve aCounts(2, UBound(aCounts, 2) + 1)
            End If
            aCounts(0, UBound(aCounts, 2)) = Sheet.Range(searchCol & i).Value
            aCounts(1, UBound(aCounts, 2)) = 1
        End If
    Next

    For i = 1 To UBound(aCounts, 2)
        Sheet.Range(itemsCol & i).Value = aCounts(0, i)
        Sheet.Range(countCol & i).Value = aCounts(1, i)
    Next
Next