vba Function for COUNT Condition Color Cells

NSrebro 

1) Copy the following code into a standard module.

Sub CountColors()
    Dim r As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("E:AJ").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For r = 4 To m
        Cells(r, 37).Value = CountRed(r)
    Next r
    Application.ScreenUpdating = True
End Sub

Function CountRed(r As Long) As Long
    Dim c As Long
    For c = 5 To 36 ' E to AJ
        If Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
            CountRed = CountRed + 1
        End If
    Next c
End Function

2) Run the Countcolors macro once to populate column AK. It can easily be expanded if you want to count green and grey in other columns.

3) Right-click the sheet tab.

Select 'View Code' from the context menu.

Copy the following code into the worksheet module.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim r As Long
    If Not Intersect(Range("E4:AJ" & Rows.Count), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        For Each rng In Intersect(Range("E4:AJ" & Rows.Count), Target).Rows
            r = rng.Row
            Cells(r, 37).Value = CountRed(r)
        Next rng
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

This will update the count automatically when you edit cells in columns E to AJ.