Worksheet Change event on different ranges with data validation

S

Savalou Dave

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
 
P

Per Jessen

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
 
S

Savalou Dave

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" <[email protected]> skrev i meddelelsen

























- Show quoted text -
Click to expand...

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

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

Similar Threads

conditional formatting w/VBA - works for some, not others 2
compile error Next without For 2
macros code & color based functions help 2
Text Color Change 3
Event Macro adjustment needed - need to change font color also 2
I moved a file from work to home and now my color macro does not w 2
Font colour not being picked up 4
macro used to change colors 12

Top