Option Explicit

Sub MaxCounts()

Dim a, i%, j%, c%, m%, r$

a = [A1:A9]
For i = LBound(a) To UBound(a)
    For j = LBound(a) To UBound(a)
        c = c + IIf(a(i, 1) = a(j, 1), 1, 0)
    Next
    If c > m Then
        m = c
        r = a(i, 1)
    End If
    c = 0
Next

Debug.Print r & " " & m

End Sub