Event Macro adjustment needed - need to change font color also

G

Guest

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
 
B

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)
 
G

Guest

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

Bob Phillips said:
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)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top