Conditional Formatting Question 1

[EliseFreedman]

Hi There

I have a series of monthly planning spreadsheets which feed into an annual spreadsheet. The idea of the sheet is that mgt update each KPI on a scale of 1 - 6 (Column G) where 1 is not started and 6 is overdue. When the scale is selected, I want to then colour another column (Column K) based on which of the scale is selected for example if 1 is selected then that cell in column K should be white. Similarly if 6 is selected then the cell should be Red.

I am using the following code to achieve the above fairly successfully. My problem is that I have to actually manually select the cells in Column K before the cells will change colour. I would like to be able to change my code so that as soon as I select the value in column G, the colour will change in column K. How do I do this?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WS_Range As String


WS_Range = "K15:K34" '<=== change to suit

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_Range)) Is Nothing Then
With Target
Select Case .Value
Case "Overdue": .Interior.ColorIndex = 3
Case "Overdue But Recoverable": .Interior.ColorIndex = 45
Case "Not Started": .Interior.ColorIndex = 2
Case "On Plan": .Interior.ColorIndex = 10
Case "Complete": .Interior.ColorIndex = 25
Case "Planned": .Interior.ColorIndex = 15
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

 

[SkipVought]

Elise,

I think that you want to use the CHANGE event and not the SELECTION CHANGE event.

When column G is changed (1 - 6) then column K is shaded accordingly. YES?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WS_Range As String, rSHADE As Range
    
    WS_Range = [b]"g15:g34"[/b] '<=== change to suit
    
    On Error GoTo ws_exit:
    Application.EnableEvents = False
    [b]
    Set rSHADE = Intersect(Target.EntireRow, Columns(11))
    [/b]
    If Not Intersect(Target, ActiveSheet.Range(WS_Range)) Is Nothing Then
        With Target
            Select Case .Value
            Case 1: [b]rSHADE[/b].Interior.ColorIndex = 3
            Case 2: [b]rSHADE[/b].Interior.ColorIndex = 45
            Case 3: [b]rSHADE[/b].Interior.ColorIndex = 2
            Case 4: [b]rSHADE[/b].Interior.ColorIndex = 10
            Case 5: [b]rSHADE[/b].Interior.ColorIndex = 25
            Case 6: [b]rSHADE[/b].Interior.ColorIndex = 15
            End Select
        End With
    End If
    
ws_exit:
    Application.EnableEvents = True
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[EliseFreedman]

Thanks for this. That works like a dream except for one thing. We have a due date built in (Column I). This only comes into play if the initial status selected was a 5 (overdue but recoverable- Amber). If the date is missed then the status will change to Overdue (6 - Red). The text in my colour column is rightly changing to Overdue but the colour is staying at amber. How can i get the colour to update to Red.

 

[SkipVought]

    If Not Intersect(Target, ActiveSheet.Range(WS_Range)) Is Nothing Then
        With Target
            Select Case .Value
            Case 1: rSHADE.Interior.ColorIndex = 3
            Case 2: rSHADE.Interior.ColorIndex = 45
            Case 3: rSHADE.Interior.ColorIndex = 2
            Case 4: rSHADE.Interior.ColorIndex = 10
            Case 5:[b]
              if intersect(.entirerow, Cells(1,"I").entirecolumn) < Date Then
                 rSHADE.Interior.ColorIndex = 3
              else
                 rSHADE.Interior.ColorIndex = 25
              end if[/b]
            Case 6: rSHADE.Interior.ColorIndex = 15
            End Select
        End With
    End If

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}