[Excel/VBA] Count occurrences of a range and list them

[Excel_VBA] Count occurrences of a range and list them

German description of how to use the scripts: https://www.tutorials.de/threads/tabelleninhalt-nach-wert-summieren.399561/#post-2063424

The "Microsoft Scripting Runtime" must be added as a reference in Visual Basic when using the scripts.

code.vb

' Counts all the occurrences of individual cell values in a given range and outputs them to a given range.
'
' The output looks like:
' [cell value] | [number of occurrences]
'
' sheet: The worksheet the specified ranges belong to
' inputRange: The input range (e.g. "B3:D5")
' outputStartCellRow: The row number of the upper left cell of the output
' outputStartCellCol: The column number of the upper left cell of the output.
'                     The number of occurrences will be output into outputStartCellCol+1
Sub countOccurrences(sheet As Worksheet, inputRange As String, outputStartCellRow As Integer, outputStartCellCol As Integer)
    Dim usageStats As Scripting.Dictionary
    Set usageStats = New Scripting.Dictionary
    
    For Each cell In sheet.Range(inputRange).Cells
        Dim name As String
        name = cell.Value
        If name <> "" Then
            If Not usageStats.Exists(name) Then
                usageStats.Add name, 1
            Else
                usageStats.Item(name) = usageStats.Item(name) + 1
            End If
        End If
    Next
    
    outputOccurrences sheet, outputStartCellRow, outputStartCellCol, usageStats
End Sub
' Prints collected occurrences
Private Sub outputOccurrences(sheet As Worksheet, outputStartCellRow As Integer, outputStartCellCol As Integer, usageStats As Scripting.Dictionary)
    Dim row As Integer
    row = outputStartCellRow
    
    For Each aname In usageStats.Keys
        sheet.Cells(row, outputStartCellCol).Value = aname
        sheet.Cells(row, outputStartCellCol + 1).Value = usageStats.Item(aname)
        row = row + 1
    Next aname
End Sub

sample-usage.vb

Sub UpdateListOfOccurrences()
    countOccurrences ActiveWorkbook.ActiveSheet, "B3:D5", 1, 6
End Sub