Excel VBA shape color changing on criteria

A created a simple dashboard in an excel file which display the values entered on a separate sheet. Depending on the values entered the color of the shape (square) is changing once the macro is activated.

I am new in excel VBA and I managed to make it work but my code is really long for what it does and I believe it could be simplified. See the example below:

Sub ScoreCard_Icon()

Dim Rng As Range
Dim ShapeName As String
Dim SHP As Shape

WebVisits = "AS_1"
BounceRate = "AS_2"
SEOVisits = "AS_3"
PPCImpressionsShare = "AS_4"
MediaImpression = "AS_5"
FacebookReach = "AS_6"
YoutubeViews = "AS_7"
RndR = "AS_8"
EShare = "AS_9"
ENOS = "AS_10"
EComSndS = "AS_11"
CARSScore = "AS_12"

Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N53")
Set SHP = Rng.Parent.Shapes(WebVisits)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If

Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N54")
Set SHP = Rng.Parent.Shapes(BounceRate)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If


Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N55")
Set SHP = Rng.Parent.Shapes(SEOVisits)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N56")
Set SHP = Rng.Parent.Shapes(PPCImpressionsShare)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N57")
Set SHP = Rng.Parent.Shapes(MediaImpression)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N58")
Set SHP = Rng.Parent.Shapes(FacebookReach)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N59")
Set SHP = Rng.Parent.Shapes(YoutubeViews)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N60")
Set SHP = Rng.Parent.Shapes(RndR)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N61")
Set SHP = Rng.Parent.Shapes(EShare)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N62")
Set SHP = Rng.Parent.Shapes(ENOS)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N63")
Set SHP = Rng.Parent.Shapes(EComSndS)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If



Set Rng = ThisWorkbook.Worksheets("Rectangle test").Range("N64")
Set SHP = Rng.Parent.Shapes(CARSScore)

If Rng.Value = "0" Then
SHP.Fill.ForeColor.RGB = RGB(246, 0, 0)
End If

If Rng.Value = "1" Then
SHP.Fill.ForeColor.RGB = RGB(255, 153, 51)
End If

If Rng.Value = "2" Then
SHP.Fill.ForeColor.RGB = RGB(223, 223, 19)
End If

If Rng.Value = "3" Then
SHP.Fill.ForeColor.RGB = RGB(102, 255, 51)
End If


End Sub

The problem is that I have 10 different sheet (reflecting values for different regions) build the same way and therefore 10 times the code you can see above but with different values. It is a real pain in the ass whenever I have to modify it or to add new regions.