Excel VBA

Count Occurences of a Digit

There were perhaps 6 columns (in the test file), each having from 3 to fifteen five-digit numbers.

At the end of the test file, I found a new “wrinkle” that I chose to ignore. It called for totals by columns.

Option Explicit

Sub CountOccursDigits()
    Dim Ones, Twos, Threes, Fours, Fives, Sixes, Sevens, Eigths, Nines, Zeros
    Dim daRow As Long, DaColm As Long, Jen As Long, Ez
    Dim Z As Long, daTot
    DaColm = Application.CountA(ActiveSheet.Range("1:1"))    'How many columns
    For Jen = 1 To DaColm   	'Step thru columns
        Cells(2, Jen).Select    'Got to row 2 in the current column
        Selection.End(xlDown).Select    'Find the last row
        daRow = ActiveCell.Row          'The row number
        For Ez = 2 To daRow         'Step thru each cell in col
            For Z = 1 To Len(Cells(Ez, Jen))    'Step thru each digit in cell
                Select Case Mid(Cells(Ez, Jen), Z, 1)   'Eval the current digit
                    Case 1
                      Ones = Ones + 1
                    Case 2
                        Twos = Twos + 1
                    Case 3
                        Threes = Threes + 1
                    Case 4
                        Fours = Fours + 1
                    Case 5
                        Fives = Fives + 1
                    Case 6
                        Sixes = Sixes + 1
                    Case 7
                        Sevens = Sevens + 1
                    Case 8
                        Eigths = Eigths + 1
                    Case 9
                        Nines = Nines + 1
                    Case 0
                        Zeros = Zeros + 1
                End Select
            Next Z  'Next digit in cell
        Next Ez     'Next row in column
    Next Jen        'Next column
    daTot = Ones + Twos + Threes + Fours + Fives + Sixes + Sevens + Eigths + Nines + Zeros
    MsgBox "Ones: " & Ones & vbCrLf & "Twos: " & Twos & vbCrLf & "Threes: " & Threes _
        & vbCrLf & "Four: " & Fours & vbCrLf & "Five: " & Fives & vbCrLf & "Six: " & Sixes _
        & vbCrLf & "Seven: " & Sevens & vbCrLf & "Eight: " & Eigths & vbCrLf _
        & "Nine: " & Nines & vbCrLf & "Zero: " & Zeros & vbCrLf & "--------" _
        & vbCrLf & "TOTAL " & daTot, vbOKOnly, "Totals"     'Show box of totals
End Sub

The first counts the number of columns and begins stepping through them. The second determines how many rows are in the current column and begins stepping through the rows. And the last steps through each digit in the current cell and adds to either the Ones, Twos, Threes, etc.. I was surprised that I could do it in so few lines of code. And this is the MsgBox that displays at the conclusion.