I'm trying to color code cells based on the value of a drop down
list. I want to use a worksheet change event since I have more than
three response options. Trouble is I have more than one response
pattern so I want the change event to be conditional to the cell
range. I have a range for each response pattern and corresponding
color coding scheme as below. Thanks in advance!



Private Sub Worksheet_Change(ByVal Target As Range)

Dim vLetter As String
Dim vColor As Long
Dim v2Letter As String
Dim v2Color As String
Dim v3Letter As String
Dim v3Color As String

Dim cRange As Range
Dim cell As Range
Dim c2Range As Range
Dim c3Range As Range

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

For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 2))
vColor = 0
Select Case vLetter
Case "YE"
vColor = 4
Case "NO"
vColor = 3
Case "CO"
vColor = 4
Case "MO"
vColor = 6
Case "PA"
vColor = 45
Case "N/"
vColor = 2

End Select
Application.EnableEvents = False
cell.Interior.ColorIndex = vColor
Application.EnableEvents = True
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor


Set c2Range = Intersect(Range("D4,D16,E10"), Range(Target
(1).Address))
If c2Range Is Nothing Then Exit Sub
For Each cell In Target
v2Letter = Left(cell.Value & " ", 5)
v2Color = 0
Select Case v2Letter
Case "Month"
v2Color = 4

Case "Quart"
v2Color = 6

Case "Never"
v2Color = 3

Case "Biann"
v2Color = 6

Case "Annua"
v2Color = 45

Case "N/A"
v2Color = 2


End Select
Application.EnableEvents = False
cell.Interior.ColorIndex = v2Color
Application.EnableEvents = True
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor

Set c3Range = Intersect(Range("F7:J7"), Range(Target(1).Address))
If c3Range Is Nothing Then Exit Sub

For Each cell In Target
v3Letter = Left(cell.Value & " ", 3)

v3Color = 0
Select Case v3Letter

Case "abc"
v3Color = 6

Case "def"
v3Color = 3


Case "jkl"
v3Color = 45

Case "mno"
v3Color = 2

End Select
Application.EnableEvents = False
cell.Interior.ColorIndex = v3Color
Application.EnableEvents = True
Next cell

End Sub