VBA Colouring of Shapes Is incorrect on first iteration - correct the remainder

Hi,

I have a piece of code which, given the cells selected, loops around creating shapes over the cells and colouring them dependant on a couple of other references (the value in the cell has a corresponding sheet with a category value in the identically addressed cell and a further sheet has coloured cells, one for each category). The code works fine, other than on the first iteration of the loop, the colour of the shape is set to one which is not within my list (nor anywhere on the workbook). I think it may have something to do with the fact I altered the palette to accomadate a nice list of gradations of blue, rather than the standard palette and somehow on the first loop the old color corresponding to the index I've replaced is instead used.

Here's my code:

Public Sub Main()
' ### Loop which gets the values of the selected cells, calls for shapes to be created on top of each of them _
' colours the shapes dependant on the category (with values in a corresponding sheet) and inserts the value
Dim rngSel As Range 'selection
Dim rngC As Range 'cell within selection
Dim strCAdd ' Address of native cell
Dim xlwsC ' categories worksheet
Dim intV As Double ' Value
Dim intCat As Integer 'colour category
Dim intCol As Long 'colour
Dim shp As Shape 'shape being added
Dim intFCol As Long 'font colour
Set rngSel = Selection 'set range to deal with (so even if selection changes, we're OK)
Set xlws = ActiveSheet
Set xlwsC = Worksheets("Group") 'where category data is held
For Each rngC In rngSel 'for each cell in selection
    strCAdd = rngC.Address 'get the cell ref e.g. $J$16
    intV = rngC.Value 'actual value
    intCat = xlwsC.Range(strCAdd).Value 'category value
    intCol = GetColour(intCat) 'get the cell colour corresponding to category
    intFCol = GetFColour(intCat) 'get the font colour corresponding to the category
    Set shp = PlaceShape(rngC, "OctV01" & rngC.Row & rngC.Column) 'set the shape name
    shp.Select 'select it (not sure this is nessecary)
    With shp.TextFrame
        .Characters.Text = Format(Round(intV, 1), "0.0") 'put the value in
        .HorizontalAlignment = xlHAlignCenter 'align the text (only works after text has been entered)
        .VerticalAlignment = xlVAlignCenter 'ditto
        .Characters.Font.ColorIndex = intFCol 'set font colour
        .Characters.Font.Size = 8 'set font size
    End With
    shp.Fill.ForeColor.RGB = intCol 'set internal colour
Next rngC

End Sub


Public Function GetColour(intCatV As Integer) As Long
' ### Gets the cell colour ###
Dim intR As Integer 'row
Dim xlws As Worksheet 'worksheet with coloured cells in A1:A7 with numbers in each
Set xlws = Worksheets("ColourCats") 'set it
For intR = 1 To 7 'range which colours are in
    If xlws.Range("A" & intR).Value = intCatV Then 'if there's a match
        GetColour = xlws.Range("A" & intR).Interior.Color 'get the colour
        Exit Function 'skip out
    End If
Next intR
   
End Function


Public Function GetFColour(intCatV As Integer) As Long
' ### Gets the font colour ###
Dim intR As Integer 'row
Dim xlws As Worksheet 'worksheet with coloured cells  and different fonts in A1:A7 with numbers in each
Set xlws = Worksheets("ColourCats")
For intR = 1 To 7
    If xlws.Range("A" & intR).Value = intCatV Then
        GetFColour = xlws.Range("A" & intR).Font.ColorIndex
        Exit Function
    End If
Next intR

End Function

Public Function PlaceShape(rng As Range, strName As String) As Shape
' ### creates a shape over a cell and assigns a given name ###
Dim intL As Integer 'left
Dim intT As Integer 'top
Dim intW As Integer 'width
Dim intH As Integer 'height
     'get dimensions of  range selection
    With rng
        intL = .Left
        intT = .Top
        intW = .Width
        intH = .Height
    End With
    Set PlaceShape = ActiveSheet.Shapes.AddShape(msoShapeOctagon, intL + 2, intT + 2, intW - 4, intH - 4)
    PlaceShape.Name = strName
End Function

Any suggestions gratefully welcomed.

Regards,

Rob