How to count and total items in a column/sheet - macos

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

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

Answer 2

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