More than 4 conditional formating?

L

Little Penny

How do I get mon the 4 conditions on Range("A4:O500")

I would like to increase it to 7

Here is my current code






Cells.Select

Selection.FormatConditions.Delete
Selection.Interior.ColorIndex = xlNone



Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A4:O500").Select
With Selection.Interior
.ColorIndex = xlNone
.Pattern = xlSolid
End With



Range("A4:M150").Select


'Using these three condition
' Always use the following line first for Cond Frmtng
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$N4=""SHIPPED"""
Selection.FormatConditions(1).Interior.ColorIndex = 4
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$I4=""IN PROUTE"""
Selection.FormatConditions(2).Interior.ColorIndex = 38
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$I4=""AMEX"""
Selection.FormatConditions(3).Interior.ColorIndex = 6



Range("N4:O150").Select


'Using these three condition
' Always use the following line first for Cond Frmtng
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$N4=""NOT SHIPPED"""
Selection.FormatConditions(1).Interior.ColorIndex = 3

Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=$N4=""SHIPPED"""
Selection.FormatConditions(2).Interior.ColorIndex = 4




Range("A1").Select
 
M

macropod

Hi Little Penny,

Conditional formatting, as such, only supports 4 conditions - the default
state plus 3 others. If you need more than this, you'll need to use vba to
format the range directly.

Cheers
 
L

Little Penny

How do I do this.

I found this code on VBAexpress.com

How do I convert my exsiting code into a case select code



Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error Goto 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Tom", "Joe", "Paul"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case "Smith", "Jones"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = True
Case 1, 3, 7, 9
Cell.Interior.ColorIndex = 5
Cell.Font.Bold = True
Case 10 To 25
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case 26 To 99
Cell.Interior.ColorIndex = 7
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub
 
M

macropod

Hi Little Penny,
How do I do this.
Click to expand...

Well, you'd have to change that code to suit your needs. For example,
change:

Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error Goto 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1

to something like:

If .Row >= 5 And .Row <= 10 And .Column >= 3 And .Column <= 10 Then

to define the range you want to apply the formatting to (the above defines
the range as C5:J10), and modify the Select case procedure, to something
like:

Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Case "NOT SHIPPED"
Cell.Interior.ColorIndex = 3
Case "SHIPPED"
Cell.Interior.ColorIndex = 4
Case "IN PROUTE"
Cell.Interior.ColorIndex = 38
Case "AMEX"
Cell.Interior.ColorIndex = 6
' Add more coses as needed, then finish off with the next two lines to
' deal with anything not already catered for.
Case Else
Cell.Interior.ColorIndex = xlNone
End Select

and change the 'Next' to 'End If'.
 
L

Little Penny

Thanks for your replies

Here is where my lack of experience shows I don't know how to format
the if statement to select the range


A4:M500 is my range
Based on the value on cell (N) I want the case select to color the row
A thru M a certain color.
 
M

macropod

Hi Little Penny,

Try this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Line As Range
On Error Resume Next
With Target
If .Row >= 4 And .Row <= 500 And .Column >= 1 And .Column <= 13 Then
Set Line = Range(Cells(.Row, 1), Cells(.Row, 13))
Select Case .Value
Case vbNullString
Line.Interior.ColorIndex = xlNone
Case "NOT SHIPPED"
Line.Interior.ColorIndex = 3
Case "SHIPPED"
Line.Interior.ColorIndex = 4
Case "IN PROUTE"
Line.Interior.ColorIndex = 38
Case "AMEX"
Line.Interior.ColorIndex = 6
' Add more cases as needed, then finish off with the next two lines to
' deal with anything not already catered for.
Case Else
Line.Interior.ColorIndex = xlNone
End Select
End If
End With
End Sub

I'm not clear as to whether you're testing for the presence of the strings
anywhere in A4:M500, or just in a particular column. I've coded for the
former. If it's the latter, change the line:
If .Row >= 4 And .Row <= 500 And .Column >= 1 And .Column <= 13 Then
to suit. Either way, whatever row is affected will have columns A:M shaded.
This range is controlled by the line:
Set Line = Range(Cells(.Row, 1), Cells(.Row, 13))

Cheers
 
L

Little Penny

It works......................................................


My final code will look like this



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Line As Range
On Error Resume Next
With Target
If .Row >= 4 And .Row <= 500 And .Column >= 14 And .Column <= 14
Then
Set Line = Range(Cells(.Row, 1), Cells(.Row, 13))
Select Case .Value
Case vbNullString
Line.Interior.ColorIndex = xlNone
Case "NOT SHIPPED"
Line.Interior.ColorIndex = 3
Case "SHIPPED"
Line.Interior.ColorIndex = 4
Case "IN PROUTE"
Line.Interior.ColorIndex = 38
Case "AMEX"
Line.Interior.ColorIndex = 6
' Add more cases as needed, then finish off with the next two lines to
' deal with anything not already catered for.
Case Else
Line.Interior.ColorIndex = xlNone
End Select
End If
End With
End Sub


Thanks again



Little Penny
 
L

Little Penny

Thanks my final code will look like this

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Line As Range
On Error Resume Next
With Target
If .Row >= 4 And .Row <= 500 And .Column >= 14 And .Column <= 14
Then
Set Line = Range(Cells(.Row, 1), Cells(.Row, 13))
Select Case .Value
Case vbNullString
Line.Interior.ColorIndex = xlNone
Case "NOT SHIPPED"
Line.Interior.ColorIndex = 3
Case "SHIPPED"
Line.Interior.ColorIndex = 4
Case "IN PROUTE"
Line.Interior.ColorIndex = 38
Case "AMEX"
Line.Interior.ColorIndex = 6
' Add more cases as needed, then finish off with the next two lines to
' deal with anything not already catered for.
Case Else
Line.Interior.ColorIndex = xlNone
End Select
End If
End With
End Sub


Thanks again macropod
 
M

Mike Fogleman

Little Penny, one final touch to shorten the code:
If .Row >= 4 And .Row <= 500 And .Column >= 14 And .Column <= 14
Then
Click to expand...
Can be changed to:
If .Row >= 4 And .Row <= 500 And .Column = 14 Then

Mike F
 
L

Little Penny

After introducing this formula into my worksheet I realize that all my
trigger cells that will change interior color are based on match and
index formulas. I believe I need a Worksheet Calculate formula. How do
I convert this formula to a worksheet Calculate formula? This existing
Formula only work for manual entry.


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Line As Range
On Error Resume Next
With Target
If .Row >= 4 And .Row <= 500 And .Column >= 1 And .Column <= 14 Then
Set Line = Range(Cells(.Row, 1), Cells(.Row, 13))
Select Case .Value
Case vbNullString
Line.Interior.ColorIndex = xlNone
Case "NOT SHIPPED"
Line.Interior.ColorIndex = 3
Case "SHIPPED"
Line.Interior.ColorIndex = 4
Case "POQA"
Line.Interior.ColorIndex = 15
Case "IN PROCESS"
Line.Interior.ColorIndex = 22
Case "INSERTING"
Line.Interior.ColorIndex = 40
Case "STMTHAND"
Line.Interior.ColorIndex = 38
Case "OD-M34"
Line.Interior.ColorIndex = 50



' Add more cases as needed, then finish off with the next two lines to
' deal with anything not already catered for.
Case Else
Line.Interior.ColorIndex = xlNone
End Select
End If
End With
End Sub
 
M

macropod

Hi Penny,

You could add something as simple as:

Private Sub Worksheet_Calculate()
Dim i As Integer
For i = 4 To 500
Call Worksheet_Change(Cells(i, 14))
Next
End Sub

This way, the formatting will be applied regardless of whether the test
strings are generated in a way that triggers a recalculation.

Also, as Mike said, you can change the line:
If .Row >= 4 And .Row <= 500 And .Column >= 14 And .Column <= 14 Then
to:
If .Row >= 4 And .Row <= 500 And .Column = 14 Then

Cheers
 
L

Little Penny

ok first thank you thank you thanks you for all your help

Below is my new code
These two statements come from information in column N
Case "NOT SHIPPED"
Line.Interior.ColorIndex = 3
Case "SHIPPED"
Line.Interior.ColorIndex = 4
If fact I just realized I do not need the "NOT SHIPPED " case
statement
But this info is in column N

If column N is SHIPPED then Columns A thru M should change color

The rest all come from Colum I
Case "POQA"
Line.Interior.ColorIndex = 15
Case "IN PROCESS"
Line.Interior.ColorIndex = 22
Case "INSERTING"
Line.Interior.ColorIndex = 40
Case "STMTHAND"
Line.Interior.ColorIndex = 38
Case "OD-M34"
Line.Interior.ColorIndex = 50
If Column I is one of the above Columns A thru M should change color

What's happening with the new code is it only works if the formula is
update to "SHIPPED" in column N.

If column I is updated to IN PROCESS,
INSERTING or one of the others it seems as if excel will flash the
interior color but go back to none.


Also is it possible the have the code cover both manual update and
update by formula?

Option Explicit
Private Sub Worksheet_Calculate()
Dim i As Integer
For i = 4 To 500
Call Worksheet_Change(Cells(i, 14))
Next
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Line As Range
On Error Resume Next
With Target
If .Row >= 4 And .Row <= 500 And .Column >= 1 And .Column <= 14 Then
Set Line = Range(Cells(.Row, 1), Cells(.Row, 13))
Select Case .Value
Case vbNullString
Line.Interior.ColorIndex = xlNone
Case "SHIPPED"
Line.Interior.ColorIndex = 4
Case "POQA"
Line.Interior.ColorIndex = 15
Case "IN PROCESS"
Line.Interior.ColorIndex = 22
Case "INSERTING"
Line.Interior.ColorIndex = 40
Case "STMTHAND"
Line.Interior.ColorIndex = 38
Case "OD-M34"
Line.Interior.ColorIndex = 50



' Add more cases as needed, then finish off with the next two lines to
' deal with anything not already catered for.
Case Else
Line.Interior.ColorIndex = xlNone
End Select
End If
End With
End Sub
 
M

macropod

Hi Little Penny,

In that case, the only code you need is:

Option Explicit
Private Sub Worksheet_Calculate()
Dim i As Integer
For i = 4 To 500
Call Worksheet_Change(Cells(i, 9))
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Line As Range
On Error Resume Next
With Target
If .Row >= 4 And .Row <= 500 And .Column = 9 Then
Set Line = Range(Cells(.Row, 1), Cells(.Row, 13))
Select Case .Value
Case vbNullString
Line.Interior.ColorIndex = xlNone
Case "POQA"
Line.Interior.ColorIndex = 15
Case "IN PROCESS"
Line.Interior.ColorIndex = 22
Case "INSERTING"
Line.Interior.ColorIndex = 40
Case "STMTHAND"
Line.Interior.ColorIndex = 38
Case "OD-M34"
Line.Interior.ColorIndex = 50
Case Else
Line.Interior.ColorIndex = xlNone
End Select
End If
End With
End Sub

You can then use Excel's standard conditional formatting to test for
"SHIPPED" in Column N. This will override the cell colouring performed by
the macro, which I think is what you'll want.

Cheers
 
L

Little Penny

Worked as advertised. I can't thank you enough

Thank u Thank u Thank u


Little Penny
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Error when no records meet criteria 2
Error when no records meet criteria - repost 3
alternate rowshading using conditional format excel 2007/2010 6
VBA Conditional formating 3
4 conditional formats 2
help with a sub 3
Conditional Formatting 2
Conditional Formatting Code 4

Top