chin15

Sub ccount()
Dim c As Range, d$, d2$, m%
    Application.FindFormat.Font.ColorIndex = 7
    Set c = Cells.Find(What:="", After:=[a1], SearchDirection:=xlNext, SearchFormat:=True)
    If Not c Is Nothing Then
        d = c.Address
        Do
            d2 = c.Address
            m = m + 1
            Set c = Cells.Find(What:="", After:=Range(d2), SearchDirection:=xlNext, SearchFormat:=True)
        Loop Until c.Address = d
    End If
    [l1] = m
End Sub