Counting cells colored by conditional formating

[Safety Bill]

I'm looking for a way to count the cells in a row, that are conditionally formatted 4 different colors. Unfortunately, the 4 colors that I'm using aren't the standard Red, Green, Blue and Yellow. I have to use more pale versions.

Also, each row contains cells that are dates, text, numbers or formulas.

All I want to do is count how many cells of each color there are and have it show in a separate cell of that row (C4).

My final "Christmas Wish" is to be able to take this count and maybe use an IF formula of some type to conditionally format the cells Column C.

Here is the result I would like to achieve:

If D4:AF4 contains 1 or more pale red cells, put the count in C4 and stop.
If D4:AF4 contains 0 pale red cells, put count in C4 and proceed to next step.
If D4:AF4 contains 1 or more pale yellow cells, put the count in C4 and stop.
If D4:AF4 contains 0 pale yellow cells, put the count in C4 and proceed to next step.
And so on for the pale green and pale blues.

I've tried all the different VBA codes that I found when searching for this on the web, but to no avail. I either get an error message or 0. Please help before the safety man loses it.

 

[T. Valko]

I'm looking for a way to count the cells in a row, that are conditionally formatted 4 different colors. Unfortunately, the 4 colors that I'm using aren't the standard Red, Green, Blue and Yellow. I have to use more pale versions.

Also, each row contains cells that are dates, text, numbers or formulas.

All I want to do is count how many cells of each color there are and have it show in a separate cell of that row (C4).

My final "Christmas Wish" is to be able to take this count and maybe use an IF formula of some type to conditionally format the cells Column C.

Here is the result I would like to achieve:

If D4:AF4 contains 1 or more pale red cells, put the count in C4 and stop.
If D4:AF4 contains 0 pale red cells, put count in C4 and proceed to next step.
If D4:AF4 contains 1 or more pale yellow cells, put the count in C4 and stop.
If D4:AF4 contains 0 pale yellow cells, put the count in C4 and proceed to next step.
And so on for the pale green and pale blues.

I've tried all the different VBA codes that I found when searching for this on the web, but to no avail. I either get an error message or 0. Please help before the safety man loses it.

If the cells are colored using conditional formatting then you should be able to write count formulas based on the rules of the conditional formatting.

 

[Safety Bill]

Thank you for responding so quickly. There are approximately 15 different conditional formats (I.e. Contains Text "N"; Date < 1/1/2012; Number > 6; Number between 4 and 6, and several others that are similar.) How do I do that and have the results show in just one cell. {For some reason I am not able to upload a sample worksheet for you to see.)

 

[T. Valko]

Thank you for responding so quickly. There are approximately 15 different conditional formats (I.e. Contains Text "N"; Date < 1/1/2012; Number > 6; Number between 4 and 6, and several others that are similar.) How do I do that and have the results show in just one cell. {For some reason I am not able to upload a sample worksheet for you to see.)

Those would be fairly easy formulas to write but I don't understand what you mean by this:

How do I do that and have the results show in just one cell.

If you have 15 different conditional formats applied then you would need 15 formulas to count each format. Do you mean you want the results of all the count formulas to be displayed together in a single cell instead of 15 individual cells?

 

[Safety Bill]

Maybe this will help, and maybe it can't be done. I have a list of contractors (Column A) with certain criteria that must be met (D4 through AF4). There are various criteria such as Y or N if they have provided an insurance certificate, or the date of the insurance, or the number of injuries they have had, or formulas that use those numbers to calculate injury rates. And each one has been colored conditionally (pale red, pale yellow, pale green, pale blue) based on the relative criteria.

So what I am trying to do is for Contractor Joe Schmoe (A4), score him in C4 based on color criteria he has in his row of data, D4:AF4. I.e. If he has 1 or more pale reds he is denied, 1 or more pale yellows then more information is required, all pale green then approved as a contractor and any pale blues he is exempt. I wish I could upload a sample for you to see.

Again any help is greatly appreciated!!! But if it cant be done so be it.

 

[T. Valko]

Maybe this will help, and maybe it can't be done. I have a list of contractors (Column A) with certain criteria that must be met (D4 through AF4). There are various criteria such as Y or N if they have provided an insurance certificate, or the date of the insurance, or the number of injuries they have had, or formulas that use those numbers to calculate injury rates. And each one has been colored conditionally (pale red, pale yellow, pale green, pale blue) based on the relative criteria.

So what I am trying to do is for Contractor Joe Schmoe (A4), score him in C4 based on color criteria he has in his row of data, D4:AF4. I.e. If he has 1 or more pale reds he is denied, 1 or more pale yellows then more information is required, all pale green then approved as a contractor and any pale blues he is exempt. I wish I could upload a sample for you to see.

Again any help is greatly appreciated!!! But if it cant be done so be it.

Ok, I understand what you're trying to do.

In your description you note only 4 colors in use. Does that mean there are only 4 conditions being tested or are some colors used for more than 1 condition?

 

[Safety Bill]

Unfortunately no. That's where the "15 or more" conditions come into play. For example, one cell criteria may have 3-5 conditional rules: "Cell Value <0.9 then pale green" & "Cell Value between 0.9 and 1.1 then pale yellow" and "Cell Value> 1.1 then pale red", and Cell Value contains 'N' then pale red.

Looks like I'm not following your K.I.S.S. philosophy.

 

[NewOrderFac33]

Do you know how to use custom functions?

Paste the following into a VBA module:

Function ColAC(TestCell As Range, TargetRange As Range, Optional SUM As Boolean)
 
    'Application.Volatile
 
    Dim TargetCell As Range
    Dim CellColor As Long
    Dim Result As Variant
 
    CellColor = TestCell.Interior.ColorIndex
 
    If SUM = True Then
        For Each TargetCell In TargetRange
            If WorksheetFunction.IsNumber(TargetCell) Then
                If TestCell.EntireRow.Hidden = False Then
                    If TargetCell.Interior.ColorIndex = CellColor Then
                        Result = Result + TargetCell.Value
                    End If
                End If
            End If
        Next
    Else
        For Each TargetCell In TargetRange
            If TestCell.EntireRow.Hidden = False Then
                If TargetCell.Interior.ColorIndex = CellColor Then
                    Result = Result + 1
                End If
            End If
        Next
    End If
    ColAC = Result
End Function

In your worksheet, you could (say) have 15 cells A1:A15, each formatted with one of your background colours. So, say in A1, you wanted to count all the cells in the range (A20:A100) whose colour matched A1's, you would have the formula
=COLAC(A1,A20:A100,true) if you wanted to SUM the values in A20:A100 with a matching colour

or

=COLAC(A1,A20:A100,false) if you wanted to COUNT the number of cells in A20:A100 with a matching colour.

You then copy this formula into your other 14 cells (making sure that as you drag down, the range of cells that you're testing against remains constant - use dollar signs where necessary.

Your test cell doesn't have to be the cell in which the formula goes either. In A1, you could have

=COLAC(B25,A20:A100,false)

if you wanted to use B25 as your colour matching cell.

Hope this helps

Pete


Does this make sense?

 

[NewOrderFac33]

Gah! Just read your post properly - it's CONDITIONAL formatting, isnt it?

Hang on, I DO have a fix for this, I'll have to dig it out...

 

[NewOrderFac33]

It's pretty big, and I DON'T take credit for it. I just tidied it up.

Just paste ALL of this into a VBA module.

You will then be able to use the formula

=COLORINDEXOFCF(A1,FALSE) to return the color index of a cell's background colour where A1 is the cell you want to test.

You'd need a formula for each cell that you wanted to check (a new column in your worksheet, maybe?), then you'd need another formula to sum up all the cells in that new column that returned a value of 1 (Black), 2 (White), 3 (Red) etc.

Public TestCell As Range
Sub AA_TransferColours()
For Each TestCell In Range("I2:I13")
TestCell.Offset(0, -1).Interior.ColorIndex = ColorIndexOfCF(TestCell, False)
Next
End Sub
'Unfortunately, the Color and ColorIndex properties of a Range don't return the color of a cell that is displayed if
'Conditional formatting is applied to the cell. Nor does it allow you to determine whether a conditional format
'is currently in effect for a cell.
'In order to determine these, you need code that will test the format conditions.
'This page describes several VBA functions that will do this for you.
'
'ActiveCondition
'This function will return the number of the condition that is currently applied to the cell.
'If the cell does not have any conditional formatting defined, or none of the conditional formats
'are currently applied, it returns 0. Otherwise, it returns 1, 2, or 3, indicating with format condition is in effect.
'ActiveCondition requires the GetStrippedValue function at the bottom of this page.
'
'NOTE: ActiveCondition may result in an inaccurate result if the following are true:
'
'You are calling ActiveCondtion from a worksheet cell, AND
'The cell passed to ActiveCondtion uses a "Formula Is" rather than
'"Cell Value Is" condition, AND
'The formula used in the condition formula contains relative addresses
'To prevent this problem, you must use absolute cell address in the condition formula.
'
'ColorOfCF
'This function will return the RGB color in effect for either the text or the background of the cell.
'This function requires the ActiveCondition function. You can call this function directly from a worksheet cell
'with a formula like:
'=ColorOfCF(A1,FALSE)
'
'ColorIndexOfCF
'This function will return the color index in effect for either the text or the background of the cell.
'This function requires the ActiveCondition function. You can call this function directly from a
'worksheet cell with a formula like:
'=ColorIndexOfCF(A1,FALSE)
'
'CountOfCF
'This function return the number of cells in a range that have a specified conditional format applied.
'Set the last argument to -1 to look at all format conditions, or a number between 1 and 3 to specify
'a particular condition. This function requires the ActiveCondition function. '
'You can call this function directly from a worksheet cell with a formula like:
'=CountOfCF(A1:A10,1)
'
'SumByCFColorIndex
'This function sums the cells that have a specified background color applied by conditional formatting.
'''''''''''''''''''''''''''''''''''''''
'
'ColorOfCF
'This function will return the RGB color in effect for either the text or the background of the cell. This function requires the ActiveCondition function. You can call this function directly from a worksheet cell with a formula like:
'=ColorOfCF(A1,FALSE)
'
'ColorIndexOfCF
'This function will return the color index in effect for either the text or the background of the cell. This function requires the ActiveCondition function. You can call this function directly from a worksheet cell with a formula like:
'=ColorIndexOfCF(A1,FALSE)
'
'
'CountOfCF
'This function return the number of cells in a range that have a specified conditional format applied. Set the last argument to -1 to look at all format conditions, or a number between 1 and 3 to specify a particular condition. This function requires the ActiveCondition function. You can call this function directly from a worksheet cell with a formula like:
'=CountOfCF(A1:A10,1)
'
'SumByCFColorIndex
'This function sums the cells that have a specified background color applied by conditional formatting.
'''''''''''''''''''''''''''''''''''''''
Function ActiveCondition(Rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant
If Rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For Ndx = 1 To Rng.FormatConditions.Count
Set FC = Rng.FormatConditions(Ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp And _
Rng.Value <= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreater
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value > Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp = Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlGreaterEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value >= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLess
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value < Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlLessEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Rng.Value <= Temp Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotEqual
Temp = GetStrippedValue(FC.Formula1)
If IsNumeric(Temp) Then
If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Temp <> Rng.Value Then
ActiveCondition = Ndx
Exit Function
End If
End If
Case xlNotBetween
Temp = GetStrippedValue(FC.Formula1)
Temp2 = GetStrippedValue(FC.Formula2)
If IsNumeric(Temp) Then
If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
(CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
ActiveCondition = Ndx
Exit Function
End If
Else
If Not Rng.Value <= Temp And _
Rng.Value >= Temp2 Then
ActiveCondition = Ndx
Exit Function
End If
End If
 
Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select
Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If
Case Else
Debug.Print "UNKNOWN TYPE"
End Select
Next Ndx
End If
ActiveCondition = 0
End Function
 
Function ColorIndexOfCF(Rng As Range, Optional OfText As Boolean = False) As Integer
Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorIndexOfCF = Rng.Font.ColorIndex
Else
ColorIndexOfCF = Rng.Interior.ColorIndex
End If
Else
If OfText = True Then
ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
Else
ColorIndexOfCF = Rng.FormatConditions(AC).Interior.ColorIndex
End If
End If
End Function
Function ColorOfCF(Rng As Range, Optional OfText As Boolean = False) As Long
Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorOfCF = Rng.Font.Color
Else
ColorOfCF = Rng.Interior.Color
End If
Else
If OfText = True Then
ColorOfCF = Rng.FormatConditions(AC).Font.Color
Else
ColorOfCF = Rng.FormatConditions(AC).Interior.Color
End If
End If
End Function
Function GetStrippedValue(CF As String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
Temp = Mid(CF, 3, Len(CF) - 3)
If Left(Temp, 1) = "=" Then
Temp = Mid(Temp, 2)
End If
Else
Temp = CF
End If
GetStrippedValue = Temp
End Function
 
Function CountOfCF(InRange As Range, _
Optional Condition As Integer = -1) As Long
Dim Count As Long
Dim Rng As Range
Dim FCNum As Integer
For Each Rng In InRange.Cells
FCNum = ActiveCondition(Rng)
If FCNum > 0 Then
If Condition = -1 Or Condition = FCNum Then
Count = Count + 1
End If
End If
Next Rng
CountOfCF = Count
End Function
Function SumByCFColorIndex(Rng As Range, CI As Integer) As Double
Dim R As Range
Dim Total As Double
For Each R In Rng.Cells
If ColorIndexOfCF(R, False) = CI Then
Total = Total + R.Value
End If
Next R
SumByCFColorIndex = Total
End Function