Condtional Format - Cell Colour change more than 3 conditions

[Kempy]

Hi All,

I was hoping to find out if there is a way to have more than three contions for conditional formatting in excel 2003.

I have a validation list in column B with 7 text options. Is there a way to condition format these to cell fill as follows

Text1 - Light Orange
Text2 - Green
Text3 - Red
Text4 - Pink
Text5 - light Green
Text6 - Blue
Text7 - Orange

Any help greatly Appreciated

Kind Regards

Kempy

 

[VoG]

This should help VBA Express : Excel - Conditional Formatting (More Than Three)

 

[Jonmo1]

This is going to require VBA Code.

Should it occur on the Entire column B, or just a specific range like B2:B10 ?

 

[Kempy]

The range is dynamic, so probably the entire column is best and should work fine for the purpose

 

[Jonmo1]

Try this.
right click on the sheet's tab - View Code
paste the following code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, MyRange As Range, c As Range, Mycolor As Variant
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set MyRange = Intersect(Target, Range("B1:B" & lr))
If Not MyRange Is Nothing Then
    For Each c In MyRange
        Select Case c.Value
            Case "Text1": Mycolor = 1
            Case "Text2": Mycolor = 2
            Case "Text3": Mycolor = 3
            Case "Text4": Mycolor = 4
            Case "Text5": Mycolor = 5
            Case "Text6": Mycolor = 6
            Case "Text7": Mycolor = 7
            Case Else: Mycolor = xlNone
        End Select
        c.Interior.ColorIndex = Mycolor
    Next c
End If
End Sub

You'll have to figure out on your own which colorindex # matches what actual color.
I've just used 1 through 7.

You can run this macro on a blank sheet to get a list of all the colorindexes

Sub ListColors()
For i = 1 To 56
    Cells(i, "B").Value = i
    Cells(i, "A").Interior.ColorIndex = i
Next i
End Sub

 

[Kempy]

awesome, works perfectley.

Thanks for your help

Kempy

 

[Jonmo1]

Glad to help, thanks for the feedback.

 

[Kempy]

Hi

I Have a slight problem, i am trying to incorporate this code with other code that someone else was very kind to help with. The problem is that when i combine them park of your code causes an error. It is to do with the intersect range definition, highlighted red below. Is tehre away around this?

Many thanks for your help

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range
    Dim LastRow As Long
    
    Const DeadCol As String = "A" '<- Your 'Dead' column
    
    Set Changed = Intersect(Target, Columns(DeadCol))
    If Not Changed Is Nothing Then
    If MsgBox("Are you sure you want to change the status?", vbYesNo, "Change Status") = vbYes Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        With Range(DeadCol & "7:" & DeadCol & LastRow)
            .AutoFilter Field:=1, Criteria1:="=DEAD"
            With .Offset(1).EntireRow
                .Copy Destination:=Sheets("Dead Deals") _
                    .Range("A" & Rows.Count).End(xlUp).Offset(1)
                .Delete
            End With
            .AutoFilter
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Rows("7:7").Select
    Selection.EntireRow.Hidden = True
    End If
    End If
    Dim lr As Long, MyRange As Range, c As Range, Mycolor As Variant
lr = Cells(Rows.Count, "B").End(xlUp).Row
[COLOR=#ff0000]Set MyRange = Intersect(Target, Range("B8:B" & lr))
[/COLOR]If Not MyRange Is Nothing Then
    For Each c In MyRange
        Select Case c.Value
            Case "Broking Introduction": Mycolor = 44
            Case "Tracking": Mycolor = 34
            Case "Broking Negotiations": Mycolor = 45
            Case "Sale": Mycolor = 43
            Case "Potential Sale": Mycolor = 35
            Case "Consultancy": Mycolor = 48
            Case "Acquisitions U/O": Mycolor = 3
            Case Else: Mycolor = xlNone
        End Select
        c.Interior.ColorIndex = Mycolor
    Next c
End If
End Sub

 

[Jonmo1]

Probably because the additional code is deleting rows, including the Target row (the row that changed)
Then when it get's to that line, target no longer exists because it was deleted.

Just reverse the code so the coloring part comes first, then the deleting rows part after that.

 

[Kempy]

Doh, so simple but that worked great.

Once again many thanks for your help.

Kempy