'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ᴇʜ