macro used to change colors

[Brian in FT W.]

I'm trying to write an event macro for a worksheet that will change a cell's
color based on the outcome of various formulas.

I can get the Conditional Format to work for 3 items, however I have 4
variables.

If a number is between 4-3.5, Blue
If a number is between 3.49-2.5, Green
If a number is between 2.49-1.10, Yellow
If a number is between 1.09-0, Red

Below is what I tried to use, and I assume that is is completely wrong.

Can anyone offer a solution or advice? Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim vNumber As String
Dim vColor As Integer
Dim cRange As Range
Dim cell As Range

Set cRange = Intersect(Range("A1:M99"), Range(Target(1).Address))
If cRange Is Nothing Then Exit Sub


vNumber = vNumber(Left(cell.Value & " ", 1))

vColor = 0
Select Case vNumber
Number "4.0:3.5"
vColor = 5
Number "3.499999:2.5"
vColor = 4
Number "2.49999:1.10"
vColor = 6
Number "1.09999:0"
vColor = 3

End Select
Application.EnableEvents = False
cell.Interior.ColorIndex = vColor
Application.EnableEvents = True
End Sub

 

[Bernie Deitrick]

Brian,

Try the code below. Note that the code should go into the sheet's
codemodule, not a standard codemodule. You might want to change

Select Case cRange.Value
to
Select Case Application.Round(cRange.Value,2)

where the 2 is your displayed decimals, so that your colors match with your
displayed values.

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cRange As Range

Set cRange = Intersect(Range("A1:M99"), Target(1))
If cRange Is Nothing Then Exit Sub

With cRange.Interior
.ColorIndex = xlNone
Select Case cRange.Value
Case Is < 0
.ColorIndex = xlNone
Case Is < 1.1
.ColorIndex = 3
Case Is < 2.5
.ColorIndex = 6
Case Is < 3.5
.ColorIndex = 4
Case Is <= 4#
.ColorIndex = 5
End Select
End With
End Sub

 

[Brian in FT W.]

thanks for the response...

This is the code that I inserted, upon my second attempt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cRange As Range

Select Case Application.Round(cRange.Value, 2)

Set cRange = Intersect(Range("A1:M99"), Target(1))
If cRange Is Nothing Then Exit Sub

With cRange.Interior
..ColorIndex = xlNone
Select Case cRange.Value
Case Is < 0
..ColorIndex = xlNone
Case Is < 1.1
..ColorIndex = 3
Case Is < 2.5
..ColorIndex = 6
Case Is < 3.5
..ColorIndex = 4
Case Is <= 4#
..ColorIndex = 5
End Select
End With
End Sub

The code did not work. I got an error that said: Statements and labels
invalid between the select case and first case. The cRange = was highlighted.

 

[Bernie Deitrick]

Brian,

Move this line:

Select Case Application.Round(cRange.Value, 2)

in place of this line:

Select Case cRange.Value

You should only have one Select Case line in your procedure.

HTH,
Bernie
MS Excel MVP

thanks for the response...

This is the code that I inserted, upon my second attempt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cRange As Range

Select Case Application.Round(cRange.Value, 2)

Set cRange = Intersect(Range("A1:M99"), Target(1))
If cRange Is Nothing Then Exit Sub

With cRange.Interior
.ColorIndex = xlNone
Select Case cRange.Value
Case Is < 0
.ColorIndex = xlNone
Case Is < 1.1
.ColorIndex = 3
Case Is < 2.5
.ColorIndex = 6
Case Is < 3.5
.ColorIndex = 4
Case Is <= 4#
.ColorIndex = 5
End Select
End With
End Sub

The code did not work. I got an error that said: Statements and labels
invalid between the select case and first case. The cRange = was

highlighted.

 

[Brian in FT W.]

That worked, thanks Bernie. Also, how would I get the font to change to white
for the Blue Cells? Is there any way to make the code work only for certain
cells, or is this a worksheet-wide application only?

Thanks once more, Brian

 

[JE McGimpsey]

One way:

Replace "A1:M99" with your desired cells, say "A1, B2, J14":

Private Sub Worksheet_Change(ByVal Target As Range)
With Target(1)
If Not Intersect(.Cells, Range("A1:M99")) Is Nothing Then
.Font.ColorIndex = xlColorIndexAutomatic
Select Case Application.Round(.Value, 2)
Case Is < 0
.Interior.ColorIndex = xlNone
Case Is < 1.1
.Interior.ColorIndex = 3
Case Is < 2.5
.Interior.ColorIndex = 6
Case Is < 3.5
.Interior.ColorIndex = 4
Case Is <= 4#
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
Case Else
.Interior.ColorIndex = xlColorIndexNone
End Select
End If
End With
End Sub

 

[Brian in FT W.]

I went with this, but it still gave me an error: Run-Time error 438
Object doesn't support this property or method.

Case Is <= 4#
..ColorIndex = 5
..Font.ColorIndex = 2

I also tried, but this didn't work.
Case Is <= 4#
.Interior.ColorIndex = 5
.Font.ColorIndex = 2

 

[JE McGimpsey]

Try pasting what I wrote into your module - you should never have had

Case is <=4#
.Interior.ColorIndex = 5

using the code I supplied.

 

[Brian in FT W.]

That works...thanks for the help.

One way:

Replace "A1:M99" with your desired cells, say "A1, B2, J14":

Private Sub Worksheet_Change(ByVal Target As Range)
With Target(1)
If Not Intersect(.Cells, Range("A1:M99")) Is Nothing Then
.Font.ColorIndex = xlColorIndexAutomatic
Select Case Application.Round(.Value, 2)
Case Is < 0
.Interior.ColorIndex = xlNone
Case Is < 1.1
.Interior.ColorIndex = 3
Case Is < 2.5
.Interior.ColorIndex = 6
Case Is < 3.5
.Interior.ColorIndex = 4
Case Is <= 4#
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
Case Else
.Interior.ColorIndex = xlColorIndexNone
End Select
End If
End With
End Sub

 

[Brian in FT W.]

Another problem with this macro. I have several people reviewing data, each
person has a tab that flows into a summation tab. The tabs where people enter
their information change color automatically. On the summation tab, you have
to hit enter 2x or F2 to activate the color. Any way to get around this?

 

[JE McGimpsey]

It's not a problem with the macro - a Worksheet_Change event fires when
the user (or an external source) makes an entry, not when a value
changes due to a calculation.

If you want colors to change automatically when a calculation occurs,
use the _Calculate() event instead.

 

[Brian in FT W.]

When I insert that command, I get the error: Compile error: proceedure
declaration does not match description of event or proceedure having the same
name.

Private Sub Worksheet_Calculate(ByVal Target As Range)
With Target(1)
If Not Intersect(.Cells, Range("A1:M99")) Is Nothing Then
..Font.ColorIndex = xlColorIndexAutomatic
Select Case Application.Round(.Value, 2)
Case Is < 0
..Interior.ColorIndex = xlNone
Case Is < 1.1
..Interior.ColorIndex = 3
Case Is < 2.5
..Interior.ColorIndex = 6
Case Is < 3.5
..Interior.ColorIndex = 4
Case Is <= 4#
..Interior.ColorIndex = 5
..Font.ColorIndex = 2
Case Else
..Interior.ColorIndex = xlColorIndexNone
End Select
End If
End With
End Sub

 

[JE McGimpsey]

Worksheet_Calculate doesn't take an argument - you'll need to specify
the cells to check in the macro.

See "Calculate Event" in XL/VBA Help for the call syntax.