countif color count

  • Thread starter Thread starter lyriquid
  • Start date Start date
L

lyriquid

i wish to count the number of cells (in a given range) that contain tx
that is the colour red. so far i have been given this code to place i
a standard module:

Function Color(rngField As Object, intColor As Integer)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If rngAct.Interior.ColorIndex = intColor Then
intCounter = intCounter + 1
End If
Next rngAct
Color = intCounter
End Function

but I am now unable to progress any further. Do I have to use th
=countif command? if so wot would formular be? Do I have to call upo
this function in an excel cell?

thanks for any help :
 
Hi
use this formula the following way:
=Color(A1:A100,color_index)
where A1:A100 is your given range and color_index the color to count
(red should be 3)

Frank
 
this code looks for the colour of the fill and not the actual colour o
the txt. wot would i have to change within the vb code to make i
search for the txt colour
 
Hi
use the following
Function Color_font(rngField As Object, intColor As Integer)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If rngAct.Font.ColorIndex = intColor Then
intCounter = intCounter + 1
End If
Next rngAct
Color_font = intCounter
End Function

Frank
 
or this version, which does fill or font colour.

Function Color_font(rngField As Object, intColor As Integer, Optional Text
As Boolean = False)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If Text Then
If rngAct.Font.ColorIndex = intColor Then
intCounter = intCounter + 1
End If
If rngAct.Interior.ColorIndex = intColor Then
intCounter = intCounter + 1
End If
End If
Next rngAct
Color_font = intCounter
End Function

=Color(A1:A100,3) returns the count of red filled cells, or
=Color(A1:A100,3, True) returns the count of red font cells

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
I'm pretty new to vba functions - so please bear with me!

I have a similar problem where I want to count any cells that have an
color fill other than the default "no fill".

Would it be possible to adapt the above code?

Many thanks in advance
Tamse
 
Hi
one easy way without changing the code would be counting all cells
within your range and subtracting the cells with the color_index for
'no fill'
Another way: change the macro as follows (will count all colors except
intcolor):

Function Non_Color(rngField As Object, intColor As Integer, Optional
Text
As Boolean = False)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If Text Then
If rngAct.Font.ColorIndex <> intColor Then
intCounter = intCounter + 1
End If
If rngAct.Interior.ColorIndex <> intColor Then
intCounter = intCounter + 1
End If
End If
Next rngAct
Non_Color = intCounter
End Function

Frank
 
Believe Bob omitted an ELSE statement in his original post. This should do
what you ask.

Function Color_font(rngField As Object, _
intColor As Integer, Optional Text As Boolean = False)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If Text Then
If rngAct.Font.ColorIndex <> xlColorIndexAutomatic Then
intCounter = intCounter + 1
End If
Else
If rngAct.Interior.ColorIndex <> xlColorIndexNone Then
intCounter = intCounter + 1
End If
End If
Next rngAct
Color_font = intCounter
End Function
 
Oops, you can remove the IntColor argument

Function Color_font(rngField As Object, _
Optional Text As Boolean = False)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If Text Then
If rngAct.Font.ColorIndex <> xlColorIndexAutomatic Then
intCounter = intCounter + 1
End If
Else
If rngAct.Interior.ColorIndex <> xlColorIndexNone Then
intCounter = intCounter + 1
End If
End If
Next rngAct
Color_font = intCounter
End Function

--
Regards,
Tom Ogilvy


Tom Ogilvy said:
Believe Bob omitted an ELSE statement in his original post. This should do
what you ask.

Function Color_font(rngField As Object, _
intColor As Integer, Optional Text As Boolean = False)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If Text Then
If rngAct.Font.ColorIndex <> xlColorIndexAutomatic Then
intCounter = intCounter + 1
End If
Else
If rngAct.Interior.ColorIndex <> xlColorIndexNone Then
intCounter = intCounter + 1
End If
End If
Next rngAct
Color_font = intCounter
End Function
Click to expand...
 
Tom's spot-on as usual, but IMO this is not the best way to count coloured
cells. A much better way is described here http://tinyurl.com/2u22g.

With this solution, you would use something like

=SUMPRODUCT(--(Colorindex(A1:H1000)<>ColorIndex(L1))

where L1 would be a cell with no fill colour

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Tom Ogilvy said:
Believe Bob omitted an ELSE statement in his original post. This should do
what you ask.

Function Color_font(rngField As Object, _
intColor As Integer, Optional Text As Boolean = False)
Dim intCounter As Integer
Dim rngAct As Range
For Each rngAct In rngField
If Text Then
If rngAct.Font.ColorIndex <> xlColorIndexAutomatic Then
intCounter = intCounter + 1
End If
Else
If rngAct.Interior.ColorIndex <> xlColorIndexNone Then
intCounter = intCounter + 1
End If
End If
Next rngAct
Color_font = intCounter
End Function
Click to expand...
 
When I add the functions to my sheet they work perfectly except tha
when I change a font color, e.g. upgrade an item to urgent th
calculations are not automatically refreshed either by changing th
setting on Tools>Options>... or when I press F9, but my other function
on the page are. Any ideas
 
Hi
one way:
add the line application.volatile at the beginning of the colorindex
function.
 
Back
Top