VBA Conditional Formatting

[cmcfalls]

Ok, I know the question has been asked several times (trust me I did
search) but I couldn't find an answer to my question...

I am trying to use VBA to shade cells based on more than 3 conditions
I think my problem is that I do not know VBA well enough to change cod
I have found in other examples to fit my needs.

Here is the example code I am trying to change:

Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range

Set rng = Intersect(Target, Range("G:G"))
If rng Is Nothing Then
Exit Sub
Else
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case "NSP"
cl.EntireRow.Interior.ColorIndex = 35
Case "UAB"
cl.EntireRow.Interior.ColorIndex = 36
Case "IA"
cl.EntireRow.Interior.ColorIndex = 37
Case "AO"
cl.EntireRow.Interior.ColorIndex = 39
Case "US"
cl.EntireRow.Interior.ColorIndex = 40
Case "A"
cl.EntireRow.Interior.ColorIndex = 0
Case Else
cl.EntireRow.Interior.ColorIndex = 0
Exit Sub
End Select
Next cl
End If

End Sub

If I want to change this to do formatting based on a single cell (o
range of cells) to change a single cell (or range of cells), what do
need to change?

E.g. I am trying to color a single cell (in a range) based on the valu
of that same cell. If it says "Completed" I want it green (color inde
35), if it says "Error" I want it yellow (color index 36), etc.

Thanks in advance for any help..

 

[Frank Kabel]

Hi
1. just change the range check in the line
Set rng = Intersect(Target, Range("G:G"))
to your needs. e.g. if you only want to check cell G1 change it to
Set rng = Intersect(Target, Range("G:1))

2. change the select case construct according to syour needs. e.g.
....
Select Case cl.Text
Case "Completed"
cl.Interior.ColorIndex = 35
Case "Error"
cl.Interior.ColorIndex = 36
...
end select
....

 

[Bob Phillips]

Here are the first two conditions. For any others just add extra Case
statements with appropriate colorindex.

Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range

Set rng = Intersect(Target, Range("G:G"))
If rng Is Nothing Then
Exit Sub
Else
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case "Completed"
cl.EntireRow.Interior.ColorIndex = 35
Case "Error"
cl.EntireRow.Interior.ColorIndex = 36
Exit Sub
End Select
Next cl
End If

End Sub

It already handles any range in column G, as it loops through each
intersecting cell.. If you want more columns, use

Set rng = Intersect(Target, Range("G:M "))

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[cmcfalls]

Almost there guys....this code below works fine, but it colors th
entire row instead of the specific cell (I want cell I4, I5, I6, etc
only colored). Where's my error?

Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range

Set rng = Intersect(Target, Range("I:I"))
If rng Is Nothing Then
Exit Sub
Else
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case "Returned"
cl.EntireRow.Interior.ColorIndex = 35
Case "Corrected & Returned"
cl.EntireRow.Interior.ColorIndex = 35
Case "Corrected, Not Yet Returned"
cl.EntireRow.Interior.ColorIndex = 3
Case "Completed, Not Yet Returned"
cl.EntireRow.Interior.ColorIndex = 3
Case "Received, Not Yet Completed"
cl.EntireRow.Interior.ColorIndex = 3
Case "Not Yet Received"
cl.EntireRow.Interior.ColorIndex = 3
Case "Violation: See Notes"
cl.EntireRow.Interior.ColorIndex = 36
Case Else
cl.EntireRow.Interior.ColorIndex = 0
Exit Sub
End Select
Next cl
End If

End Su

 

[Frank Kabel]

Hi
change all lines like
cl.EntireRow.Interior.ColorIndex = value
to
cl.Interior.ColorIndex = value

 

[Bob Phillips]

Again we go

Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range

If notIntersect(Target, Range("I:I")) Is Nothing Then
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case "Returned"
cl.Interior.ColorIndex = 35
Case "Corrected & Returned"
cl.Interior.ColorIndex = 35
Case "Corrected, Not Yet Returned"
cl.Interior.ColorIndex = 3
Case "Completed, Not Yet Returned"
cl.Interior.ColorIndex = 3
Case "Received, Not Yet Completed"
cl.Interior.ColorIndex = 3
Case "Not Yet Received"
cl.Interior.ColorIndex = 3
Case "Violation: See Notes"
cl.Interior.ColorIndex = 36
Case Else
cl.Interior.ColorIndex = 0
Exit Sub
End Select
Next cl
End If

End Sub



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Bob Phillips]

oops last minute change

correction to

If Not Intersect(Target, Range("I:I")) Is Nothing Then


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Again we go

Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range

If notIntersect(Target, Range("I:I")) Is Nothing Then
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case "Returned"
cl.Interior.ColorIndex = 35
Case "Corrected & Returned"
cl.Interior.ColorIndex = 35
Case "Corrected, Not Yet Returned"
cl.Interior.ColorIndex = 3
Case "Completed, Not Yet Returned"
cl.Interior.ColorIndex = 3
Case "Received, Not Yet Completed"
cl.Interior.ColorIndex = 3
Case "Not Yet Received"
cl.Interior.ColorIndex = 3
Case "Violation: See Notes"
cl.Interior.ColorIndex = 36
Case Else
cl.Interior.ColorIndex = 0
Exit Sub
End Select
Next cl
End If

End Sub



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[cmcfalls]

With much gratitiude, I cower in the shadows of your knowledge.

Thanks a million...

 

[Bob Phillips]

Hey, easy now<G>

Bob