Twee keer private sub laten werken

[jeroen562]

Wie kan mij helpen om deze code te laten werken. Hij doet het niet doordat de naam (worksheet_change) hetzelfde is, maar als ik de naam verander bij één dan krijg ik een foutmelding.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    If Range("c31").Value < 0.8 Then Sheets("Startpunt").Shapes(11).Fill.ForeColor.SchemeColor = 10: Exit Sub
    If Range("c31").Value > 0.9 Then Sheets("Startpunt").Shapes(11).Fill.ForeColor.SchemeColor = 11: Exit Sub
    Sheets("Startpunt").Shapes(11).Fill.ForeColor.SchemeColor = 52
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    If Range("c34").Value < 0.4 Then Sheets("Startpunt").Shapes(21).Fill.ForeColor.SchemeColor = 10: Exit Sub
    If Range("c34").Value > 0.5 Then Sheets("Startpunt").Shapes(21).Fill.ForeColor.SchemeColor = 11: Exit Sub
    Sheets("Startpunt").Shapes(21).Fill.ForeColor.SchemeColor = 52
End Sub

Alvast bedankt!

 

[OctaFish]

Waarom niet gecombineerd tot:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    If Range("c31").Value < 0.8 Then Sheets("Startpunt").Shapes(11).Fill.ForeColor.SchemeColor = 10: Exit Sub
    If Range("c31").Value > 0.9 Then Sheets("Startpunt").Shapes(11).Fill.ForeColor.SchemeColor = 11: Exit Sub
    Sheets("Startpunt").Shapes(11).Fill.ForeColor.SchemeColor = 52
    If Range("c34").Value < 0.4 Then Sheets("Startpunt").Shapes(21).Fill.ForeColor.SchemeColor = 10: Exit Sub
    If Range("c34").Value > 0.5 Then Sheets("Startpunt").Shapes(21).Fill.ForeColor.SchemeColor = 11: Exit Sub
    Sheets("Startpunt").Shapes(21).Fill.ForeColor.SchemeColor = 52
End Sub

 

[jeroen562]

Die code werkt niet probeer maar uit.
Je krijgt de fout:

Dubbele declaratie in huidige bereik.

Groeten.

 

[snb]

Dit lijkt me voldoende:

Private Sub Worksheet_Change(ByVal Target As Range)
   Sheets("Startpunt").Shapes(11).Fill.ForeColor.SchemeColor = iif([C31]<0.8,10,iif([C31]>0.9,11,52))
   Sheets("Startpunt").Shapes(21).Fill.ForeColor.SchemeColor = iif([C34]<0.4,10,iif([C31]>0.5,11,52))
End Sub

En als de shapes in het zelfde werkblad staan als van de gebeurtenis worksheet_change:

Private Sub Worksheet_Change(ByVal Target As Range)
   Shapes(11).Fill.ForeColor.SchemeColor = iif([C31]<0.8,10,iif([C31]>0.9,11,52))
   Shapes(21).Fill.ForeColor.SchemeColor = iif([C34]<0.4,10,iif([C31]>0.5,11,52))
End Sub

Maar het lijkt me niet handig deze code bij iedere verandering van het werkblad te laten uitvoeren:

Private Sub Worksheet_Change(ByVal Target As Range)
   if not Intersect(target,[C31,C34]) is nothing then Shapes(iif(target.row=31,11,21)).Fill.ForeColor.SchemeColor = iif(target<0.4 + iif(target.row=31,0.4,0),10,iif(target>0.5+iif(target.ros=31,0.4,0),11,52))
End Sub

 

[jeroen562]

Bedankt Snb.

In mijn geval werkt de eerste perfect. Bij het openen van het werkblad worden die twee cellen herberekend en verder zal er geen wijziging plaats vinden in het blad.

Groeten

 

[snb]

Dan is de gebeurtenis Activate voor de hand liggender:

Private Sub Worksheet[COLOR="Red"]_Activate()[/COLOR]
   Shapes(11).Fill.ForeColor.SchemeColor = iif([C31]<0.8,10,iif([C31]>0.9,11,52))
   Shapes(21).Fill.ForeColor.SchemeColor = iif([C34]<0.4,10,iif([C31]>0.5,11,52))
End Sub