Issue with "worksheet_change" event

Longtitude

New Member
Joined
Mar 24, 2017
Messages
2
Hello all,
I have produced a piece of code for the "worksheet_change" event but run into a problem.

What the code does:
Whenever one or more of the KeyCells is updated the code should run and update the color of its linked shape.

What is does now:
If only one KeyCell changes its value the shape, depending on the value of the KeyCell, will change its color.
If more KeyCells changes their values it only changes the first shape!

HTML:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("M25,L25,K44,L44")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        
        If Target.Address = "$M$25" Then
        
            If Target.Value < 99 Then
                Sheets("Dashboard").Shapes("Odial1").Fill.ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Target.Value >= 99 And Target.Value < 99.2 Then
                Sheets("Dashboard").Shapes("Odial1").Fill.ForeColor.RGB = RGB(255, 128, 0)
            Else
                Sheets("Dashboard").Shapes("Odial1").Fill.ForeColor.RGB = RGB(0, 204, 0)
            End If
        
        End If
    
    If Target.Address = "$L$44" Then
        
            If Target.Value < 99 Then
                Sheets("Dashboard").Shapes("Odial2").Fill.ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Target.Value >= 99 And Target.Value < 99.2 Then
                Sheets("Dashboard").Shapes("Odial2").Fill.ForeColor.RGB = RGB(255, 128, 0)
            Else
                Sheets("Dashboard").Shapes("Odial2").Fill.ForeColor.RGB = RGB(0, 204, 0)
            End If
        
    End If
    
    If Target.Address = "$L$25" Then
        
            If Target.Value < 97 Then
                Sheets("Dashboard").Shapes("Idial1").Fill.ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Target.Value >= 97 And Target.Value < 97.5 Then
                Sheets("Dashboard").Shapes("Idial1").Fill.ForeColor.RGB = RGB(255, 128, 0)
            Else
                Sheets("Dashboard").Shapes("Idial1").Fill.ForeColor.RGB = RGB(0, 204, 0)
            End If
    End If
    
    If Target.Address = "$K$44" Then
        
            If Target.Value < 97 Then
                Sheets("Dashboard").Shapes("Idial2").Fill.ForeColor.RGB = RGB(255, 0, 0)
            ElseIf Target.Value >= 97 And Target.Value < 97.5 Then
                Sheets("Dashboard").Shapes("Idial2").Fill.ForeColor.RGB = RGB(255, 128, 0)
            Else
                Sheets("Dashboard").Shapes("Idial2").Fill.ForeColor.RGB = RGB(0, 204, 0)
            End If
    End If
 
       
    End If
End Sub

Your help is much appreciated.

With Regards
Longtitude
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
I haven't fully tested it, but try...

Code:
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)

    [COLOR=darkblue]Dim[/COLOR] KeyCells [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] rCell [COLOR=darkblue]As[/COLOR] Range
    
    [COLOR=darkblue]Set[/COLOR] KeyCells = Range("M25,L25,K44,L44")
    
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Application.Intersect(KeyCells, Target) [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
           
        [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] rCell [COLOR=darkblue]In[/COLOR] Target
        
            [COLOR=darkblue]If[/COLOR] rCell.Address = "$M$25" [COLOR=darkblue]Then[/COLOR]
            
                [COLOR=darkblue]If[/COLOR] Target.Value < 99 [COLOR=darkblue]Then[/COLOR]
                    Sheets("Dashboard").Shapes("Odial1").Fill.ForeColor.RGB = RGB(255, 0, 0)
                [COLOR=darkblue]ElseIf[/COLOR] Target.Value >= 99 And Target.Value < 99.2 [COLOR=darkblue]Then[/COLOR]
                    Sheets("Dashboard").Shapes("Odial1").Fill.ForeColor.RGB = RGB(255, 128, 0)
                [COLOR=darkblue]Else[/COLOR]
                    Sheets("Dashboard").Shapes("Odial1").Fill.ForeColor.RGB = RGB(0, 204, 0)
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            
            [COLOR=darkblue]ElseIf[/COLOR] rCell.Address = "$L$44" [COLOR=darkblue]Then[/COLOR]
                
                    [COLOR=darkblue]If[/COLOR] rCell.Value < 99 [COLOR=darkblue]Then[/COLOR]
                        Sheets("Dashboard").Shapes("Odial2").Fill.ForeColor.RGB = RGB(255, 0, 0)
                    [COLOR=darkblue]ElseIf[/COLOR] rCell.Value >= 99 And rCell.Value < 99.2 [COLOR=darkblue]Then[/COLOR]
                        Sheets("Dashboard").Shapes("Odial2").Fill.ForeColor.RGB = RGB(255, 128, 0)
                    [COLOR=darkblue]Else[/COLOR]
                        Sheets("Dashboard").Shapes("Odial2").Fill.ForeColor.RGB = RGB(0, 204, 0)
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
                
            [COLOR=darkblue]ElseIf[/COLOR] rCell.Address = "$L$25" [COLOR=darkblue]Then[/COLOR]
                
                    [COLOR=darkblue]If[/COLOR] rCell.Value < 97 [COLOR=darkblue]Then[/COLOR]
                        Sheets("Dashboard").Shapes("Idial1").Fill.ForeColor.RGB = RGB(255, 0, 0)
                    [COLOR=darkblue]ElseIf[/COLOR] rCell.Value >= 97 And rCell.Value < 97.5 [COLOR=darkblue]Then[/COLOR]
                        Sheets("Dashboard").Shapes("Idial1").Fill.ForeColor.RGB = RGB(255, 128, 0)
                    [COLOR=darkblue]Else[/COLOR]
                        Sheets("Dashboard").Shapes("Idial1").Fill.ForeColor.RGB = RGB(0, 204, 0)
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]ElseIf[/COLOR] rCell.Address = "$K$44" [COLOR=darkblue]Then[/COLOR]
                
                    [COLOR=darkblue]If[/COLOR] rCell.Value < 97 [COLOR=darkblue]Then[/COLOR]
                        Sheets("Dashboard").Shapes("Idial2").Fill.ForeColor.RGB = RGB(255, 0, 0)
                    [COLOR=darkblue]ElseIf[/COLOR] rCell.Value >= 97 And rCell.Value < 97.5 [COLOR=darkblue]Then[/COLOR]
                        Sheets("Dashboard").Shapes("Idial2").Fill.ForeColor.RGB = RGB(255, 128, 0)
                    [COLOR=darkblue]Else[/COLOR]
                        Sheets("Dashboard").Shapes("Idial2").Fill.ForeColor.RGB = RGB(0, 204, 0)
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
       [COLOR=darkblue]Next[/COLOR] rCell
       
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]

Hope this helps!
 
Last edited:
Upvote 0

Forum statistics

Threads
1,215,416
Messages
6,124,774
Members
449,187
Latest member
hermansoa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top