Function CountByColor(InputRange As Range)
Dim cl As Range, TempCount As Double
Application.Volatile
TempCount = 0
On Error Resume Next
For Each cl In InputRange.Cells
If cl.Interior.ColorIndex<> xlNone Then TempCount = TempCount + 1
Next cl
On Error GoTo 0
Set cl = Nothing
CountByColor = TempCount
End Function