On Mar 6, 1:49*pm, "Per Jessen" wrote:
Hi

The problem is that your code exit the macro if Target don't intersect with
the first test range and there are missing some end ifs.

Look at this:

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

Application.EnableEvents = False

Set cRange = Intersect(Range("D3:J17"), Range(Target(1).Address))
If Not cRange Is Nothing Then
* * 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
* * * * cell.Interior.ColorIndex = vColor
* * Next cell
* * 'Target.Offset(0, 1).Interior.colorindex = vColor
End If

Set c2Range = Intersect(Range("D4,D16,E10"), Range(Target(1).Address))
If Not c2Range Is Nothing Then
* * 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
* * * * cell.Interior.ColorIndex = v2Color
* * Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor
End If

Set c3Range = Intersect(Range("F7:J7"), Range(Target(1).Address))
If Not c3Range Is Nothing Then
* * 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
* * * * cell.Interior.ColorIndex = v3Color
* * Next cell
End If
Application.EnableEvents = True
End Sub

Regards,
Per

"Savalou Dave" skrev i ...



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- Hide quoted text -

- Show quoted text -

Thanks Per! That's working great! All the best.