'Worksheet change not working for multiple objects
I would like to color objects (circles) based on cell value - at the moment just first object is doing an action. What is the issue?
Private Sub Worksheet_Change(ByVal Target As Range)
'1'
If Intersect(Target, Range("D5")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value < 0.31 Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbRed
ElseIf Target.Value >= 0.31 And Target.Value < 0.32999 Then
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbYellow
Else
ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbGreen
End If
End If
'2'
If Intersect(Target, Range("D6")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value > 0.64 Then
ActiveSheet.Shapes("Oval 2").Fill.ForeColor.RGB = vbRed
ElseIf Target.Value <= 0.64 And Target.Value > 0.65999 Then
ActiveSheet.Shapes("Oval 2").Fill.ForeColor.RGB = vbYellow
Else
ActiveSheet.Shapes("Oval 2").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub
Solution 1:[1]
The problem is that if it is not D5 you Exit Sub
If Intersect(Target, Range("D5")) Is Nothing Then Exit Sub
So it never checks the second because it already exit at the first.
Change it into a construct like this:
If Not Intersect(Target, Range("D5")) Is Nothing Then
' do stuff 1
ElseIf Not Intersect(Target, Range("D6")) Is Nothing Then
' do stuff 2
End If
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | Pᴇʜ |
