Count Number of Highlighted Cells

elephant97

Board Regular
Joined
Sep 18, 2002
Messages
63
I have a spreadsheet that I go through and highlight different cells based on data requirements. Specifically, I highlight the cells either green, yellow, or red. How can I use the COUNT function (or something else) to count the number of greens, yellows, and reds and return the totals for each color in a different spreadsheet??? Thanks!
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
You will need to change the color to your colors. JSW

Public myCount As Long
Sub myColor()
'By Joe Was
Dim myRowNum As Long
myRowNum = ActiveSheet.UsedRange.Rows.Count
Selection.Select
Do Until Selection.Row = myRowNum + 1
'Find red text.
If Selection.Font.ColorIndex = 3 Then
'To select entire row, un-comment below!
'Selection.EntireRow.Select
GoTo mySelect
Else
Selection.Offset(1, 0).Select
End If
Loop
End
mySelect:

End Sub

'This custom function will count all the red text or background in the current selection.

'"Public myCount As Long"
'Above must be the first line in the module as: Public myCount As Long
'This could go into a Sheet Module or a standard module.

Sub CheckCells(CurrRange As Range)
Dim myRange As Range

'This Function will count colored text cells.
myCount = 0
Set myRange = Selection
For Each Cell In myRange
'3=red colored text.
'Record a macro with your color, to get your index value.
'You can change the code value as needed.
'If Cell.Interior.ColorIndex = 3 Then myCount = myCount + 1 Else
'Use the above for cell background color and below for font color.
If Cell.Font.ColorIndex = 3 Then myCount = myCount + 1 Else
Next Cell
End Sub

Sub redCount()
'By Joe Was
Dim myRange As Range

'This is the calling sub "redCount."
'You must select the area to count colored text in!
Selection.Select
Set myRange = Selection
Call CheckCells(myRange)
'This is the message box with the count.
'You can report myCount anyway you want.
MsgBox "The total number of red cells," & Chr(13) & _
"in your current selection are: " & Chr(13) & Chr(13) _
& " [ " & myCount & " ]"
End Sub
 
Upvote 0
The code comments tells you how. Record a macro for the cell color setting you have then view the code and exchange your value for my value in the code above. JSW
 
Upvote 0
Howdy, a slight different function makes changing the target color a little easier, point and click type stuff, if you bury the following function in a normal module:<pre>
Function CountByColor(InputRange As Range, ColorRange As Range) As Long
Dim cl As Range, TmpCount As Long, ColorIndex As Integer
Application.Volatile
ColorIndex = ColorRange.Interior.ColorIndex
TmpCount = 0
On Error Resume Next
For Each cl In InputRange.Cells
If cl.Interior.ColorIndex = ColorIndex _
Then TmpCount = TmpCount + 1
Next cl
CountByColor = TmpCount
End Function</pre>

Then you can use it in a spreadsheet like the following where the first range is the range to count and the second range holds the color to count:
Book4
ABCDEF
114
220
323
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sheet1


Click on the formula to see it in the formula bar. Perhaps this is of help...

Have a great weekend!
 
Upvote 0
Thanks Nate! That works. But that is only half of my problem. I forgot to mention that within each type of color, there is a number 1,2,3,4,5, or 6. For example there may be 16 red cells containing the number 1 and 10 yellow cells containing the number 4 and 7 green cells containing the number 2. So, I need a function that will count the number of green cells with the number 1 and the number of red cells with the number 1 and the number of yellow cells with the number 1. Then, that needs to continue for the remaining numbers, 2-6. I hope that isn't too confusing. It basically would take your example and populate the colored cells with a number, 1-6. Thanks!!!
 
Upvote 0
You're welcome. Hmmm, that is a twist, would something like the following be satisfactory?<pre>
Function CountByColor(InputRange As Range, ColorRange As Range) As Long
Dim cl As Range, TmpCount As Long, ClrIndex As Integer, myNum As Integer
Application.Volatile
ClrIndex = ColorRange.Interior.ColorIndex
myNum = ColorRange.Value
TmpCount = 0
On Error Resume Next
For Each cl In InputRange
If cl.Interior.ColorIndex = ClrIndex And cl.Value = myNum _
Then TmpCount = TmpCount + 1
Next cl
CountByColor = TmpCount
End Function</pre>
Book4
ABCDEF
1113
2311
36111
4221
51620
6421
731
83133
931
1040
1153341
12640
13150
14651
153555
16562
17561
185561
19
202
Sheet1


Hope I'm reading you. Have a nice weekend.
 
Upvote 0
That function does work, but I have quite a few macros that are very long. Anytime I run one of the macros, this function is executed each time the macro makes a change to the spreadsheet. This is causing me to have to wait nearly 10 mintues for the macro to complete. If I take the function out, the macro runs in about 12 seconds. What options do I have???
 
Upvote 0
Howdy Elephant, you have two options, I prefer the 2nd.

1) Remove Application.Volatile from the function above. This will keep the results from recalculating, speeding up your procedures. However, if you make changes to the data, the results won't update.

2) The other way, and perhaps most functional, is to switch Excel's calculation mode to manual at the beginning of your procedure by adding code to the procedure like the following:<pre>
Dim n As Long
n = Application.Calculation 'store user's calc. mode
Application.Calculation = xlCalculationManual</pre><pre></pre>
Then at the end of your procedure, switch the calc. mode back to it's original setting by adding the following code:<pre>
Application.Calculation = n 'restore user's calc. mode</pre>

Hope this helps.

_________________
Cheers,<font size=+2><font color="red"> Nate<font color="blue"> Oliver</font></font></font>
This message was edited by NateO on 2002-09-25 18:19
 
Upvote 0
This equation works! However, I can not see "ColorByColor" under "View Macros" in my worksheet. I am not sure but I believe this is causing the following problem: I have to drill into the cell in order for it to recalculate when I have made changes. How do I make the quation automatically calculate?

I have already made sure that autocalculation is on and I have also tried to write the Macro from the "Developer" tab but then the module has is already populated with:
Sub CountByColor()
'
' CountByColor Macro
'
'
End Sub

Following their format but inserting your formula, there is an issue with the first line. I have tried the following:
Function CountByColor(InputRange As Range, ColorRange As Range) As Long
Problem: Equation works but doesn't auto calculate and can't see "ColorByColor" under the Macros list.

Sub CountByColor(InputRange As Range, ColorRange As Range) As Long
Problem: "As Long" creates an issue (I don't understand the error)

Sub CountByColor(InputRange As Range, ColorRange As Range)
Problem: Equation doesn't work

Please help
 
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top