Conditional Formatting with more than 3 conditions

  • Thread starter Thread starter Sara_Chase
  • Start date Start date
S

Sara_Chase

I'm currently designing a worksheet that contains all of our department
tasks. Each task may have one of the following status: Open, On-going,
For Review / Approval, Verified, Closed, Pending, Rejected. Each of
this status has its own assigned background cell color (applies to the
whole row). I am looking a workaround to Excel's limit of 3 condition
to do this.

Any thoughts?
 
'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "H1:H10"

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 "Open":
.Interior.ColorIndex = 3 'red
Case "For Review / Approval":
.Interior.ColorIndex = 6 'yellow
Case "Verified":
.Interior.ColorIndex = 5 'blue
Case "Closed":
.Interior.ColorIndex = 10 'green
Case "Pending":
.Interior.ColorIndex = 38 'rose
Case "Rejected":
.Interior.ColorIndex = 37 'pale blue
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
Hi.

I've tried the VB out and it works great. Is it possible to extend the
color to the rest of the row just like in the conditional formatting?

Thanks again!
 
Of course <g>

'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "H1:H10"

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 "Open":
.Entirerow.Interior.ColorIndex = 3 'red
Case "For Review / Approval":
.Entirerow.Interior.ColorIndex = 6 'yellow
Case "Verified":
.Entirerow.Interior.ColorIndex = 5 'blue
Case "Closed":
.Entirerow.Interior.ColorIndex = 10 'green
Case "Pending":
.Entirerow.Interior.ColorIndex = 38 'rose
Case "Rejected":
.Entirerow.Interior.ColorIndex = 37 'pale blue
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
Hi again!

I've got one more question ... instead of the entire row, how do yo
set the color for selected cells only, say column 1 to 10?

Thanks in advance
 
I have a follow-up question ... so sorry ...

The code doesn't seem to work if one of the cell (computed) within the
row has a value. I have this "estimated due date" column wherein I
compute the date that the task is due based on the priority and the
date that the task was raised.
 
'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "H1:H10"

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 "Open":
Me.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex = 3
'red
Case "For Review / Approval":
Me.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex = 6
'yellow
Case "Verified":
Me.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex = 5
'blue
Case "Closed":
Me.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex = 10
'green
Case "Pending":
Me.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex = 38
'rose
Case "Rejected":
Me.Cells(.Row, 1).Resize(, 10).ColorIndex = 37 'pale
blue
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
That is because a referenced cell change doesn't trigger the change event
for monitored cells. It can be circumvented by using the Calculate event to
trigger the code for any change, not efficient but it works

Const WS_RANGE As String = "H1:H10"

'-----------------------------------------------------------------
Private Sub Worksheet_Calculate()
'-----------------------------------------------------------------
Dim cell As Range
For Each cell In Range(WS_RANGE)
Call ColourMe(cell)
Next cell
End Sub

'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Call ColourMe(Target)
End If

ws_exit:
Application.EnableEvents = True
End Sub


'-----------------------------------------------------------------
Private Sub ColourMe(ByRef Target As Range)
'-----------------------------------------------------------------
With Target
Select Case .Value
Case "Open":
.Parent.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex
= 3 'red
Case "For Review / Approval":
.EntireRow.Interior.ColorIndex = 6 'yellow
Case "VerifiedParent.Cells(.Row, 1).Resize(, 10)"
.Parent.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex
= 5 'blue
Case "Closed":
.Parent.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex
= 10 'green
Case "Pending":
.Parent.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex
= 38 'rose
Case "Rejected":
.Parent.Cells(.Row, 1).Resize(, 10).Interior.ColorIndex
= 37 'pale blue
End Select
End With
End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
Bob Hi,
1. it seems not to work value coming from a formula
2. when the value is removed it keeps the format

can you assist
thanks


Bob Phillips said:
Of course <g>

'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "H1:H10"

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 "Open":
.Entirerow.Interior.ColorIndex = 3 'red
Case "For Review / Approval":
.Entirerow.Interior.ColorIndex = 6 'yellow
Case "Verified":
.Entirerow.Interior.ColorIndex = 5 'blue
Case "Closed":
.Entirerow.Interior.ColorIndex = 10 'green
Case "Pending":
.Entirerow.Interior.ColorIndex = 38 'rose
Case "Rejected":
.Entirerow.Interior.ColorIndex = 37 'pale blue
End Select
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub



--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
Click to expand...
 
Back
Top