Value based Text Colors
This works great: My Final code looks like this:
Option Explicit
Enum eColors
Black = 1
Red = 3
Blue = 5
Maroon = 9
End Enum
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target,
Range("C5:D28,C31:D34,G5:H28,G31:G34,N5:O28,N31:O3 4,R5:S28,R31:S34")) Is
Nothing Then
Select Case
Intersect(Range("C5:D28,C31:D34,G5:H28,G31:G34,N5: O28,N31:O34,R5:S28,R31:S34"),
Target)
Case ""
Target.Font.Bold = False
Target.Font.ColorIndex = Black
Case "Open"
Target.Font.Bold = True
Target.Font.ColorIndex = Maroon
Case "OPEN"
Target.Font.Bold = True
Target.Font.ColorIndex = Maroon
Case "open"
Target.Font.Bold = True
Target.Font.ColorIndex = Maroon
Case Is -9
Target.Font.Bold = True
Target.Font.ColorIndex = Red
Case Is < -13.99
Target.Font.Bold = True
Target.Font.Italic = True
Target.Font.ColorIndex = Blue
Case Else
Target.Font.Bold = False
Target.Font.ColorIndex = Black
End Select
End If
End Sub
Thank you very much.
"Tom Ogilvy" wrote in message
...
Private Sub Worksheet_Change(ByVal Target As Range)
if Target.count 1 then exit sub
if not intersect(target,Range("A1:B10")) is nothing then
' color the cell based on condition
end if
End Sub
this works on the specified cells: A1:B10
I have written it to do nothing if multiple cells are changed
simultaneously. You may prefer to handle this event
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as Range, cell as Range
if not intersect(target,Range("A1:B10")) is nothing then
set rng = Intersect(Target,Range("A1:B10")
for each cell in rng
' color the cell based on condition
Next
end if
End Sub
--
Regards,
Tom Ogilvy
"JohnH" wrote in message
nk.net...
I have been trying to set a range of cells Text colors based on the value
in
the cell. I need the color to change as the data is being entered. When
I
use the "Worksheet_Change(ByVal Target As Range)" function I cannot set a
specific range, any cell on the sheet changes when I enter data.
I would prefer not to loop through the range checking each cell since
this
not only takes time, it is not immediate either.
Any help would be greatly appreciated.
John
|