Color the shapes based on cell value usingfor loop

[wasantha]

I want to color the shape based on cell value. for this i have used if condition and it work correctly but issue is there are more shapes and when i used if function error appeared as a " Procedure too large " i want to eliminate that.

After i have used for loop but it not meet the my requirement. Pls share any one know this. below is the for loop cording

Sub RoundedRectangle1_Click()
Dim i As Integer
For i = 1 To 5
If Range("B4").Value = i Then
ActiveSheet.Shapes("Smiley Face 77").Fill.ForeColor.SchemeColor = 3
ActiveSheet.Shapes("Smiley Face 78").Fill.ForeColor.SchemeColor = 3
ActiveSheet.Shapes("Smiley Face 79").Fill.ForeColor.SchemeColor = 3
ActiveSheet.Shapes("Smiley Face 80").Fill.ForeColor.SchemeColor = 3
ActiveSheet.Shapes("Smiley Face 81").Fill.ForeColor.SchemeColor = 3
ActiveSheet.Shapes("Smiley Face 82").Fill.ForeColor.SchemeColor = 3
ActiveSheet.Shapes("Smiley Face 83").Fill.ForeColor.SchemeColor = 3
End If

Next i
End Sub