Optimise Repeated Code For Object

A while ago I was playing with an excel balanced scorecard which used various on change events of the cells to change the colour of an object (circle). Recently I have been looking at this again and have learned that I can lose some of the .select tags to improve & reduce the code. What we have now is 20 different PI's, each with an oibject assigned, called 'PISHAPE1' through to 'PISHAPE20'. Originally, the code checked every single controll cell, which could be either red, amber, green or no data, which would be black.

What I have works but I am sure there is a more efficient method, rather than repeating the case red, amber, green etc. The first part of the code is repeated 20 times for the different objects, just changing the shape number.

Dim cel As Range
For Each cel In Range("controlcell1").Cells
Select Case cel.Text
Case "Red"
ActiveSheet.Shapes("PISHAPE1").Fill.ForeColor.SchemeColor = 10
Case "Green"
ActiveSheet.Shapes("PISHAPE1").Fill.ForeColor.SchemeColor = 3
Case "Amber"
ActiveSheet.Shapes("PISHAPE1").Fill.ForeColor.SchemeColor = 51
Case "No Data"
ActiveSheet.Shapes("PISHAPE1").Fill.ForeColor.SchemeColor = 0
'etc.
Case Else
End Select
Next

SO following on from above, the next code for PISHAPE2 is as follows:........................