Aug 30 2022 06:55 AM
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
Aug 30 2022 07:11 AM
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.
Aug 30 2022 07:30 AM
Aug 30 2022 07:56 AM
Solution
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.
Aug 30 2022 08:46 AM
Nov 11 2022 03:06 PM
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.
Nov 12 2022 03:27 AM
Could you explain in more detail what you want? Thanks in advance.
Nov 12 2022 07:04 AM
Nov 12 2022 08:47 AM
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
Nov 12 2022 10:54 PM
Nov 13 2022 07:29 PM
Nov 14 2022 03:43 AM
The counts should be updated automatically when you change the value of one or more cells in E2:XFD99.
Nov 14 2022 12:09 PM
Nov 14 2022 01:16 PM
Just changing a color won't work - it doesn't trigger an event in Excel.
Apr 21 2023 12:39 AM
Apr 21 2023 04:42 AM
@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.
Apr 24 2023 05:07 AM - edited Apr 24 2023 05:21 AM
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
Apr 24 2023 05:56 AM
Can you explain in more detail what you want to accomplish? Thanks in advance.
Jul 07 2023 01:56 PM
@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.
Jul 07 2023 02:27 PM
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?
Aug 30 2022 07:56 AM
Solution
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.