Thread: Cell Color change by state of other feild

You could do it with conditional formatting.
I know you have 4 conditions and Excel 2003 only allows 3 but depending on your application you might be able to work with that.

Select all of your cells with values in ColumnA, and fill them GREEN
Then select cell A1, fill it GREEN, and then from the menus select 'Conditional Formating'

You want 3 conditions as follows:

Condition1
"Formula is"

=AND(B1<>"",C1="",D1="",E1="")

'Format', 'Pattern' RED

Condition2
"Formula is"

=AND(B1<>"",C1<>"",D1="",E1="")

'Format', 'Pattern' ORANGE

Condition3
"Formula is"

=AND(B1<>"",C1<>"",D1<>"",E1="")

'Format', 'Pattern' YELLOW

Then use the format painter to copy that formating to all cells in ColumnA that have your data in.

This does mean that if you have anything that doesn't match the conditional formatting rules the cell will be green, but it seems from your implementation that maybe that wouldn't happen anyway?
If it would then a VBA solution would be needed.

As 2003 only supports 3 conditional formating state, you would then need to do it completely differently and use VBA to detect a change in the sheet, and then apply colouring etc manually.
You will first need to remove all the conditional formating of those cells that you already have, and then place the following code into the 'Sheet' area of the VBA. (Click on the worksheet tab it is for, 'View Code', and paste into the editor that opens)

The code below repeats what the conditional formating is doing for you now.

Option Explicit
Const CI_NONE = xlColorIndexNone
Const CI_NO_CHANGE = -255
Const CI_AUTO = xlColorIndexAutomatic
Const CI_RED = 3
Const CI_ORANGE = 46
Const CI_YELLOW = 6
Const CI_GREEN = 4

Private Sub Worksheet_Change(ByVal Target As Range)

Dim r As Long
Dim targetrow As Range

With Target.Parent ' With the current worksheet
    For Each targetrow In Target.Rows
        If Not Intersect(targetrow, .Range("B1:F100")) Is Nothing Then ' An example range to limit operation over
            r = targetrow.Row
            Conditional_Format .Cells(r, "A"), _
                               (.Cells(r, "B") <> "" And .Cells(r, "C") = "" And .Cells(r, "D") = "" And .Cells(r, "E") = ""), .Cells(r, "A"), CI_RED, CI_NO_CHANGE, _
                               (.Cells(r, "B") <> "" And .Cells(r, "C") <> "" And .Cells(r, "D") = "" And .Cells(r, "E") = ""), .Cells(r, "A"), CI_ORANGE, CI_NO_CHANGE, _
                               (.Cells(r, "B") <> "" And .Cells(r, "C") <> "" And .Cells(r, "D") <> "" And .Cells(r, "E") = ""), .Cells(r, "A"), CI_YELLOW, CI_NO_CHANGE, _
                               (.Cells(r, "B") <> "" And .Cells(r, "C") <> "" And .Cells(r, "D") <> "" And .Cells(r, "E") <> ""), .Cells(r, "A"), CI_GREEN, CI_NO_CHANGE, _
                               True, .Cells(r, "A"), CI_NONE, CI_NO_CHANGE ' A final catchall statement to remove the color if none above are met
        End If
    Next
End With
End Sub

Function Conditional_Format(cell As Range, _
                            test1 As Boolean, value1 As Variant, fillcolor1 As Integer, fontcolor1 As Integer, _
                            ParamArray conditional_formats() As Variant)
                            ' eg.
                            'test2 As Boolean, value2 As Variant, fillcolor2 As Integer, fontcolor2 As Integer, _
                            test3 As Boolean, value3 As Variant, fillcolor3 As Integer, fontcolor3 As Integer, _
                            test4 As Boolean, value4 As Variant, fillcolor4 As Integer, fontcolor4 As Integer)

' Will apply 'value' and 'color' to 'range' for first test=TRUE
' The first set of parameters are given as an example, the paramarray can then be filled with as many more as needed
Dim index As Integer
cell.FormatConditions.Delete

If test1 Then
    cell.Value = value1
    If fillcolor1 <> CI_NO_CHANGE Then cell.Interior.ColorIndex = fillcolor1
    If fontcolor1 <> CI_NO_CHANGE Then cell.Font.ColorIndex = fontcolor1
    Exit Function
End If

' Test the other conditions if there are any
index = LBound(conditional_formats)
Do While index <= UBound(conditional_formats)
    If UBound(conditional_formats) < (index + 3) Then Exit Do
    If conditional_formats(index) Then
        cell.Value = conditional_formats(index + 1) ' Value
        If conditional_formats(index + 2) <> CI_NO_CHANGE Then cell.Interior.ColorIndex = conditional_formats(index + 2) ' Fill Color
        If conditional_formats(index + 3) <> CI_NO_CHANGE Then cell.Font.ColorIndex = conditional_formats(index + 3) ' Font Color
        Exit Do
    End If
    index = index + 4
Loop

End Function

You will need to check that the RED section correctly defines the area you want the code to operate over.

To add another condition to that you would need to:

- Define the ColorIndex constant that you wanted to use at the top of the code, eg.

Const CI_BLUE = 5

- Add the extra column to all the 'Conditional format' lines that exist already, eg:

(.Cells(r, "B") <> "" And .Cells(r, "C") <> "" And .Cells(r, "D") <> "" And .Cells(r, "E") <> "" And .Cells(r, "F") = ""), .Cells(r, "A"), CI_GREEN, CI_NO_CHANGE, _

- Add an extra line of conditional formating to cover the condition involving the new column, eg.

(.Cells(r, "B") <> "" And .Cells(r, "C") <> "" And .Cells(r, "D") <> "" And .Cells(r, "E") <> "" And .Cells(r, "F") <> ""), .Cells(r, "A"), CI_BLUE, CI_NO_CHANGE

Hopefully that makes sense, if not feel free to ask questions and I'll try to answer

Sorry, it is working correctly, but it only changes when the data changes. I didn't realise you were pasting this into sheets that already had data.
Do this on each sheet:

1) Select your cell area that has the dates already in it.
2) Select COPY
3) Without changing the selection, select PASTE

That will cause the colourings to be as they should be for the existing data.

In what way does it no longer work? Do you get an error message, or does it just seem to do 'nothing' ?

No worries, glad to hear it is working, I was scratching my head somewhat over this