vba Function for COUNT Condition Color Cells

Hello community!

I have a spreadsheet that is require manual input (about about 50-100 new rows per day). The spreadsheet has about 30 columns and each column has different conditional formatted rules that generate 3 colours - grey (not applicable), red (required), green (completed).

For each row I need vba function that will count the number of RED cells (conditional formatted colours). I have made vba code but as a result (on the cell) gives an error: #VALUE!. But on the function Argument is giving the right result.

the vba function code that I am using is the following:

Public Function CountColorCells(ByRef thisRange As Range) As Long
'Variable declaration
Dim lColorCounter As Long
Dim rngCell As Range
'loop throught each cell in the range
For Each rngCell In thisRange
'Checking Red color
If rngCell.DisplayFormat.Interior.Color = RGB(255, 0, 0) Then
lColorCounter = lColorCounter + 1
End If
Next
'Return the value
CountColorCells = lColorCounter
End Function

Can someone help me please?

Thanks you,

Nik

Formulas and Functions

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.

27 Replies

HansVogelaar
MVP
Aug 30, 2022
NSrebro

Unfortunately, the DisplayFormat property cannot be used in a custom function that is used in a cell formula. You can only call such a function in other VBA code.

Refer to the conditions behind the conditional formatting rules instead.

Or use VBA code to fill the column with the counts for Red.
- NSrebro
  Copper Contributor
  Aug 30, 2022
  Hans, thanks for the reply and confirming me that DisplayFormat property cannot be used in this way, I thought that this is the case for the error.
  Each column has different conditional formatting rule for each colour, if I refer to all of those conditions, the end function will be very messy 😞
  Can you give me more details about the VBA code that will fill the column with the count for Red? If possible some example of the code?
  - HansVogelaar
    MVP
    Aug 30, 2022
    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.

Forum Discussion

vba Function for COUNT Condition Color Cells

27 Replies

Resources