SOLVED

vba Function for COUNT Condition Color Cells

Copper Contributor

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).

spread.PNG

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.

function.PNG

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

27 Replies

@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.

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?
best response confirmed by NSrebro (Copper Contributor)
Solution

@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.

 

Hans, you are genius! Your step-by-step explanation is brilliant and the final outcome works very smoothly!

Thanks a lot for this!

Regards,
Nik

@Hans Vogelaar 

 

How can you manipulate this code to spit out the information by column instead of rows? 

Example it spits out on column AK for each row

 

i want it to spit out in the last row for each column

 

May you manipulate the code for that? Can’t seem to get it to work.

@Zoolander 

Could you explain in more detail what you want? Thanks in advance.

So in your solution the output displays in column AK in rows (AK4,AK5,AK6,AK7, etc)

Can you make it so it reads the conditional formatting by column?

In which the output could display at the bottom. For example the output would be on E100, F100, G100, H100, etc

@Zoolander 

Let's say you want to count the red cells in rows 2 to 99 starting in column E.

In a standard module:

Sub CountColors()
    Dim c As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("2:99").Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    For c = 5 To m
        Cells(100, c).Value = CountRed(c)
    Next c
    Application.ScreenUpdating = True
End Sub

Function CountRed(c As Long) As Long
    Dim r As Long
    For r = 2 To 99
        If Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
            CountRed = CountRed + 1
        End If
    Next r
End Function

And in the worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim c As Long
    If Not Intersect(Range(Cells(2, 5), Cells(99, Columns.Count)), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        For Each rng In Intersect(Range(Cells(2, 5), Cells(99, Columns.Count)), Target).Rows
            c = rng.Column
            Cells(100, c).Value = CountRed(c)
        Next rng
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub
This is it! Will give multiple colors a try and if I can’t figure that out I will message back.

Thank you so much Hans
So now through testing.

Can’t seem to get the automation portion to work. The first one runs great but I can’t seem to get an automatic calculation from the second portion.

Pasted everything on the worksheet portion but nothing changes when new red cells are highlighted. Only works when module code is ran

@Zoolander 

The counts should be updated automatically when you change the value of one or more cells in E2:XFD99.

Do I have to indicate it as E2:J99?

I only indicate as shown above (“2:99”) and it works when I run it.

Just doesn’t seem to automate when I make red changes.

@Zoolander 

Just changing a color won't work - it doesn't trigger an event in Excel.

hi why is the data in colomn AK, how can I change that
?

@wattan290 

@NSrebro had data in columns A through AJ, so the next available column AK was used for counting red cells. This is represented in the code in Cells(r, 37). 37 is the column number of column AK (A=1, B=2, C=3, ...)

If you want to use another column, change the value 37.

@Hans Vogelaar 

 

great , dank je 

if i need to have that data in one cell and not a row , how to do? make a hidden and sum that row or is there an more easy way

 

 

@wattan290 

Can you explain in more detail what you want to accomplish? Thanks in advance.

@Hans Vogelaar  I have tried to use your code and several others to count the number of correct (green) answers and calculate scores for students.  Could you please review my work and help me with sheet 4 (DL Exams)?  I cannot seem to get the functions created and ran properly.  I will be glad to email you the worksheet if you want.

 

VBA.PNGWS.PNG

@rgall005 

Could you attach a small sample workbook demonstrating the problem (without sensitive data), or if that is not possible, make it available through OneDrive, Google Drive, Dropbox or similar?

1 best response

Accepted Solutions
best response confirmed by NSrebro (Copper Contributor)
Solution

@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.

 

View solution in original post