for i = 1 to 10
Set shp = ActiveSheet.Shapes(format(1000 + i,"0000"))
Select Case Range("a1").offset(i-1,0).Value
Case Is = 0
shp.Fill.ForeColor.SchemeColor = 9
Case Is = 450
shp.Fill.ForeColor.SchemeColor = 10
Case Is = 50
shp.Fill.ForeColor.SchemeColor = 13
Case Else
shp.Fill.ForeColor.SchemeColor = 50
End Select
Next


--
Regards,
Tom Ogilvy


"Paul" wrote in message
m...
Does anybody know how to loop the following code:
I need to increase the shape number by 1 each loop and
the case range has to drop down one cell for each loop.
thank you inmensly to the person that can answer this.
calpino

Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape

Set shp = ActiveSheet.Shapes("1001")
Select Case Range("a1").Value
Case Is = 0
shp.Fill.ForeColor.SchemeColor = 9
Case Is = 450
shp.Fill.ForeColor.SchemeColor = 10
Case Is = 50
shp.Fill.ForeColor.SchemeColor = 13
Case Else
shp.Fill.ForeColor.SchemeColor = 50
End Select