Event Macro adjustment needed - need to change font color also

[nick s]

Thanks to David McRitchie for the event Macro below I am now able to change
background colors of cells as they are written. I now found that I have
another problem, is there a way to get the font to change colors, as in white
font with the
dark color of a cell and visa versa, a black font with lighter color cells?

thanks, Nick

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'David McRitchie, 2000-08-08 rev. 2000-08-14
' http://www.mvps.org/dmcritchie/excel/event.htm
Dim vLetter As String
Dim vColor As Integer
Dim cRange As Range
Dim cell As Range
'***************** check range ****
Set cRange = Intersect(Range("E2:E99"), Range(Target(1).Address))
If cRange Is Nothing Then Exit Sub
'**********************************

For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 1))
'see colors.htm and event.htm in same directory as
' http://www.mvps.org/dmcritchie/excel/excel.htm
vColor = 0 'default is no color
Select Case vLetter
Case "GF7"
vColor = 34
Case "GY9"
vColor = 36
Case "EV2"
vColor = 39
Case "EL5"
vColor = 41
Case "FJ6"
vColor = 38
Case "GY8"
vColor = 37
Case "FY1"
vColor = 35
Case "GA4"
vColor = 34
Case "FE5"
vColor = 36
Case "GB5"
vColor = 39
Case "GK6"
vColor = 41
Case "GB7"
vColor = 38
Case "GY4"
vColor = 37
Case "GE7"
vColor = 35
Case "GF3"
vColor = 39
Case "GT2"
vColor = 41
Case "GT8"
vColor = 38
Case "EW1"
vColor = 37
Case "TX9"
vColor = 35
End Select
Application.EnableEvents = False 'should be part of Change macro
cell.Interior.ColorIndex = vColor
Application.EnableEvents = True 'should be part of Change macro
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor
' use Text instead of Interior if you prefer
End Sub

 

[Bob Phillips]

I'm not going to work out which of those colours are dark and which are
light, but this stripped down version should get you going

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vLetter As String
Dim vColor As Long
Dim yColor As Long
Dim cRange As Range
Dim cell As Range

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


For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 1))
vColor = 0 'default is no color
yColor = xlColorIndexAutomatic
Select Case vLetter
Case "GF7"
vColor = 34
yColor = 2 ' white
Case "TX9"
vColor = 35
yColor = xlColorIndexAutomatic
End Select
Application.EnableEvents = False 'should be part of Change macro
cell.Interior.ColorIndex = vColor
cell.Font.ColorIndex = yColor
Application.EnableEvents = True 'should be part of Change macro
Next cell
End Sub




--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[nick s]

Thank you, you guys are great.....Nick

I'm not going to work out which of those colours are dark and which are
light, but this stripped down version should get you going

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vLetter As String
Dim vColor As Long
Dim yColor As Long
Dim cRange As Range
Dim cell As Range

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


For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 1))
vColor = 0 'default is no color
yColor = xlColorIndexAutomatic
Select Case vLetter
Case "GF7"
vColor = 34
yColor = 2 ' white
Case "TX9"
vColor = 35
yColor = xlColorIndexAutomatic
End Select
Application.EnableEvents = False 'should be part of Change macro
cell.Interior.ColorIndex = vColor
cell.Font.ColorIndex = yColor
Application.EnableEvents = True 'should be part of Change macro
Next cell
End Sub




--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)