Change Cell Color dependent on Cell Contents

[Bill]

In VBA code, I need to have the background color of the cells in Column H
change depending on Text in the Cell. I can not use conditional formating
because I have to many codes and colorsr.

Code
A-1 background color Green
A-2 background color Green
G-1 background color Yellow
G-2 background color Yellow
G-3 background color Orange
CA-1 background color Blue
GA-1 background color Black
GA-2 background color Gray

 

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
With Target
If .Column = 8 Then
Select Case .Value
Case "A-1": .Interior.ColorIndex = 10 'Green
Case "A-2": .Interior.ColorIndex = 10 'Green
Case "G-1": .Interior.ColorIndex = 6 'Yellow
Case "G-2": .Interior.ColorIndex = 6 'Yellow
Case "G-3": .Interior.ColorIndex = 46 ' Orange
Case "CA-1": .Interior.ColorIndex = 5 'Blue
Case "GA-1": .Interior.ColorIndex = 1 'Black
Case "GA-2": .Interior.ColorIndex = 16 'Gray
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


You might also want to check out this free add-in
http://www.xldynamic.com/source/xld.CFPlus.Download.html

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Don Guillett]

or

Select Case Target.Value
Case Is = "a-1", "a-2": x = 10
'case is etc
Case Else
End Select
Target.Interior.ColorIndex = x

 

[Bob Phillips]

Typo alert

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Application.EnableEvents = False
With Target
If .Column = 8 Then
Select Case .Value
Case "A-1": .Interior.ColorIndex = 10 'Green
Case "A-2": .Interior.ColorIndex = 10 'Green
Case "G-1": .Interior.ColorIndex = 6 'Yellow
Case "G-2": .Interior.ColorIndex = 6 'Yellow
Case "G-3": .Interior.ColorIndex = 46 ' Orange
Case "CA-1": .Interior.ColorIndex = 5 'Blue
Case "GA-1": .Interior.ColorIndex = 1 'Black
Case "GA-2": .Interior.ColorIndex = 16 'Gray
End Select
End If
End With

ws_exit:
Application.EnableEvents = True
End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Bill]

Thanks. I got the typo but it worked great.

Bill