Count Number of Highlighted Cells

[elephant97]

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!

 

[Joe Was]

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

 

[elephant97]

How do I change it to my colors?

 

[Joe Was]

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

 

[NateO]

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
	A	B	C	D	E	F
1						14
2						20
3						23
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!

 

[elephant97]

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!!!

 

[NateO]

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
	A	B	C	D	E	F
1	1				1	3
2			3		1	1
3	6		1		1	1
4		2			2	1
5	1	6			2	0
6	4				2	1
7					3	1
8	3		1		3	3
9					3	1
10					4	0
11	5	3	3		4	1
12	6				4	0
13			1		5	0
14	6				5	1
15		3	5		5	5
16	5				6	2
17	5				6	1
18	5	5			6	1
19
20		2
Sheet1

Hope I'm reading you. Have a nice weekend.

 

[elephant97]

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???

 

[NateO]

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

 

[sparkles]

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