Function that returns the total number of cells in a range i

jimi143

New Member
Joined
Feb 22, 2002
Messages
6
I have a long range of cells in which the cell text is formatted in different colors. Has anyone created a custom function that can return the number of cells in a range that the text is formatted in a certain color (red, blue, black, etc.)?

Thanks,
Jim
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
On 2002-02-23 13:08, jimi143 wrote:
I have a long range of cells in which the cell text is formatted in different colors. Has anyone created a custom function that can return the number of cells in a range that the text is formatted in a certain color (red, blue, black, etc.)?

Thanks,
Jim

What condition/criterion is used to format the text in a given cell as red?
 
Upvote 0
The text color of the cell is user defined using the standard colors available in Excel. I would like to put a formula at the bottom of a long range of cells that counts the number of cells in the above range that have red text formatting.

Thanks,

Jim
 
Upvote 0
Hi

I answered this heavly on the old boad with VBA to do just this:

A friend Ivan F Moala edited it to colour of text .. have a look post answet by me and then Ivan, will be in first archive, the original code was by a great friend in Western Australia Dave Hawley http://www.ozgrid.com under vba section.

Credit to he guys who did the real work, have a look at both, ill see if i can find the code as well



_________________
Good Luck
HTH

Rdgs
==========
Jack in the UK
This message was edited by Jack in the UK on 2002-02-24 14:27
 
Upvote 0
On 2002-02-23 13:35, jimi143 wrote:
The text color of the cell is user defined using the standard colors available in Excel. I would like to put a formula at the bottom of a long range of cells that counts the number of cells in the above range that have red text formatting.

Thanks,

Jim

User-defined, meaning: user makes the text red without using any known/explicit criterion?

Jim: If so, you'll need VBA-code to obtain desired counts. The Archives of the board has some code for similar situations.

Aladin
This message was edited by Aladin Akyurek on 2002-02-23 13:55
 
Upvote 0
Jimi,

If you bury this in a normal module in your visual basic editor:

Function SumByColor(InputRange As Range, ColorRange As Range) As Double
Dim cl As Range, TempSum As Double, ColorIndex As Integer
ColorIndex = ColorRange.Cells(1, 1).Font.ColorIndex
TempSum = 0
On Error Resume Next
For Each cl In InputRange.Cells
If cl.Font.ColorIndex = ColorIndex Then TempSum = TempSum + cl.Value
Next cl
On Error GoTo 0
Set cl = Nothing
SumByColor = TempSum
End Function

And use the following formula:

=SumByColor(A3:A9,A1)

Where the first paramter is the range to sum and the second is the range that has the font color you want to evaluate against.

Hope this helps. Cheers,

Nate
 
Upvote 0
Put this into a normal module. Call the function by typing =TURNED(yourrange) where yourrange is say A1:A10. You could bundle this up as an Add-In, too, so it's available on to all Excel files on your machine. Shout out if you want to know how to do this.

Public Function Turned(MyRng As Range) As String

For Each c In MyRng
If c.Font.ColorIndex = 3 And c.Value<> "" Then Red = Red + 1
If c.Font.ColorIndex = 32 And c.Value<> "" Then blue = blue + 1
If c.Font.ColorIndex = xlColorIndexAutomatic And c.Value<> "" Then black = black + 1
Next c

Turned = Red & " red " & blue & " blue " & black & " black"

End Function


Edit- Sorry, Nate, didn't realise you'd already answered this, the above is my first ever function and my beer-sodden brain took a while to get around it :)
This message was edited by Mudface on 2002-02-23 14:12
 
Upvote 0
I suppose it would be more helpful if I answered the question, sorry about that. Same deal, put the following in a normal module:

Function CountByColor(InputRange As Range, ColorRange As Range) As Double
Dim cl As Range, TempCount As Double, ColorIndex As Integer
ColorIndex = ColorRange.Cells(1, 1).Font.ColorIndex
TempCount = 0
On Error Resume Next
For Each cl In InputRange.Cells
If cl.Font.ColorIndex = ColorIndex Then TempCount = TempCount + 1
Next cl
On Error GoTo 0
Set cl = Nothing
CountByColor = TempCount
End Function

Now use the following formula:

=CountByColor(A3:A9,A1)

Where the first paramter is the range to count and cell a1 has the font criteria to evaluate against (this cell must have a value).

HTH. Cheers, Nate
 
Upvote 0
THANKS NATE!

I have added one little piece to the code to disregard empty cells. I have one more question that you might be able to help me with.

The formula works great the first time you run it, but if a cell text color is changed from red to another color after that, the result does not change. Is there an additional step that I put into my code that checks for changes to the cells prompts it to recount?

Function CountByColor(InputRange As Range, ColorRange As Range) As Double
Dim cl As Range, TempCount As Double, ColorIndex As Integer
ColorIndex = ColorRange.Cells(1, 1).Font.ColorIndex
TempCount = 0
On Error Resume Next
For Each cl In InputRange.Cells
If cl.Value <> "" And cl.Font.ColorIndex = ColorIndex Then TempCount = TempCount + 1
Next cl
On Error GoTo 0
Set cl = Nothing
CountByColor = TempCount
End Function

Thanks again,

Jim
 
Upvote 0
I'm having some trouble with this as well. This formula's not too keen with even a manual re-calc.

I wonder if there's an event procedure you would do that would rewrite the formula to the appropriate cell, like workbook_close or sheetdeactive or selectionchange where:

range(YourRange) = "=CountByColor(A3:A9,A1)"

or call the function in the sub and return the value:

range("a40") = CountByColor(range("a3:9"),range("a1"))

Could do a workbook_open and ontime procedure combination to have the result refresh every few seconds....

Not perfect....

Cheers, Nate
This message was edited by NateO on 2002-02-25 08:44
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,177
Members
448,554
Latest member
Gleisner2

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