Using VBA: Extending limits of Conditional Formatting

[Guest]

In a particular column in my spreadsheet I have set up conditional formats to
change the background colour and font colour if certain words are inserted.
The conditional Formatting option on the tool bar gives me a maximum range
of three.

how can i extend this using VBA?

 

[Guest]

You can have as many as you want with this. It;s worksheet code so
right-click the tab, view code and paste in.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim CellVal As String
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
CellVal = Target
Set WatchRange = Range("A1:c100") 'change to suit

If Not Intersect(Target, WatchRange) Is Nothing Then
Select Case CellVal
Case "Dog"
Target.Interior.ColorIndex = 5
Case "Cat"
Target.Interior.ColorIndex = 10
Case "Other"
Target.Interior.ColorIndex = 6
Case "Rabbit"
Target.Interior.ColorIndex = 46
Case "Goat"
Target.Interior.ColorIndex = 45
End Select
End If
End Sub

Mike

 

[Guest]

You can use arbitrary conditions in VBA:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("B9"), Target) Is Nothing Then
Exit Sub
End If
v = Target.Value
clrs = Array("red", "blue", "green", "yellow")
cds = Array(3, 5, 10, 6)
For i = 0 To 3
If v = clrs(i) Then
Application.EnableEvents = False
Target.Interior.ColorIndex = cds(i)
Application.EnableEvents = True
End If
Next
End Sub

This worksheet code looks for changes in cell B9. If the contents become
"red", "blue", "green", or "yellow" then the background color changes.

 

[Guest]

Thankyou Mike

It works like a dream

You can have as many as you want with this. It;s worksheet code so
right-click the tab, view code and paste in.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim CellVal As String
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
CellVal = Target
Set WatchRange = Range("A1:c100") 'change to suit

If Not Intersect(Target, WatchRange) Is Nothing Then
Select Case CellVal
Case "Dog"
Target.Interior.ColorIndex = 5
Case "Cat"
Target.Interior.ColorIndex = 10
Case "Other"
Target.Interior.ColorIndex = 6
Case "Rabbit"
Target.Interior.ColorIndex = 46
Case "Goat"
Target.Interior.ColorIndex = 45
End Select
End If
End Sub

Mike

 

[Chris Pederson]

Hi Mike I'm having a simular problem but I need an entire Row to change
color to change as a result of the value of one cell is there way to do
this using this VBA?

 

[JE McGimpsey]

One way:

In Mike's code, instead of

Target.Interior.ColorIndex = x

use

Target.EntireRow.Interior.ColorIndex = x

 

[tepermanj]

When I delete the value in a cell the color doesn't revert to white.

 

[Dave ferret]

being an absolute beginner at VBA, i'm floundering in ever deeper waters, ive
created a employee leave worksheet, which is along the lines that it requires
more colours than allowed by excel, the code is a god send, but this is the
only VBA code that is on the worksheet.
How can i run this piece of code? as when itry to run it it asks for a macro
which i have tried to look up and learn using the excel help.

 

[Bernie Deitrick]

Dave,

You cannot run this macro since it is code for an Excel event, which means that Excel runs the code
when something specific happens - in this case, a change is made to a cell on the sheet.

If you want to run the code as a macro, the code will need to be modified to run from a regular
codemodule. For example, select the cells that you want to have formatted, and run code like this.

Sub ApplyFormats()
Dim WatchRange As Range
Dim myC As Range
Set WatchRange = Range("A1:C100") 'change to suit
For Each myC In WatchRange
If Not IsError(Application.VLookup(myC.Value, Range("ColorTable"), 2, False)) Then
myC.Interior.ColorIndex = Application.VLookup(myC.Value, Range("ColorTable"), 2, False)
End If
Next myC
End Sub

For this code to work, you need to create a named range ColorTable, where the range includes your
values and color indexes:

Dog 5
Cat 10
Other 6
Rabbit 46
Goat 45

HTH,
Bernie
MS Excel MVP

 

[Judy Rose]

This looks like it will work for me, need some things clarified, firstly I
want the specified row to change to the given back ground color when I update
the value of the progress indicator from 1-16 (each type of application has a
numerical value between 1 and 16 in my sheet) also I have specific colors for
each level 1 through 16, how do I find the correct number to specify the
color I want?

Thank you for your help.

(In addition since this is for work and the e-mail I specify for this is
home would you kindly send me a note to (e-mail address removed) when you do
respond to this?)

Thank you again.

 

[stevedemo77]

Mike,
I just found this post, and it works great! It works if you type the value
into the cell, but I need it to execute if data is pasted into the worksheet
and it meets the criteria for each case. Is there something in the code that
can be modified to make that happen rather than having to actually type the
word in each cell?

Thanks,
Steve

 

[Dave Peterson]

The code will work if you paste a single cell in that watchrange (A1:C100)?

If you're pasting multiple cells, then the code exits right away:
If Target.Cells.Count > 1 Then Exit Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RngToInspect As Range
Dim myIntersect As Range
Dim myCell As Range
Dim myColor As Long

Set RngToInspect = Me.Range("A1:c100") 'change to suit

Set myIntersect = Intersect(RngToInspect, Target)

If myIntersect Is Nothing Then
'not in the range
Exit Sub
End If

For Each myCell In myIntersect.Cells
myColor = -9999
Select Case LCase(myCell.Value)
Case Is = LCase("dog"): myColor = 5
Case Is = LCase("cat"): myColor = 10
Case Is = LCase("Other"): myColor = 6
Case Is = LCase("Rabbit"): myColor = 46
Case Is = LCase("Goat"): myColor = 45
End Select

If myColor < 0 Then
'do nothing
Else
myCell.Interior.ColorIndex = myColor
End If
Next myCell
End Sub