Filling in autoshapes

[GTstartup]

I'm trying to fill in a Autoshape in excel based on the result of a calculation.

i.e. if cell B1>0 then fill in autoshape 136 with red.

I am using this code:

Private Sub Worksheet_Calculate()
Dim ThisWS As Worksheet

Set ThisWS = Me
If ThisWS.Range("b1") > 0 Then
ThisWS.Shapes(136).Fill.ForeColor.SchemeColor = 10 ' Red
Else
ThisWS.Shapes(136).Fill.ForeColor.SchemeColor = 0
End If

End Sub

When I do this excel returns the message

"run time error (then a bunch of numbers)
The index into the specified collection is out of bounds"

The autoshape is a donut

It seems to work if the autoshape number is lower like 50.

If there is a better way to do this I would appreciate the help.

 

[fmr110]

Private Sub Calculate()

Row = 1 'Row=1
Column = 2 'Column=B

If Cells(Row, Column) > 0 Then

ActiveSheet.Shapes("Donut 1").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10

Else

ActiveSheet.Shapes("Donut 1").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 0


End If

End Sub