Heat mapping with excel and VBA

[ialexander03]

Well, I am under no doubt this has been answered a million times, but can I figure it? Hell to the no, is the answer!! So I need your help.

I have created a map of the of South of England, but post code region, which is the important bit, and the reason why I have created one rather than downloading someone elses, as there doesn't seem to be one split by post code, only County/State.

I have the picture pasted onto the sheet, we will use Sheet 1 as its name. And then I have drawn (by eye!!) the regions over the top with autoshape (we will call these Freeform: Shape 1, shape 2 etc etc) to make the map but with auto shapes.

I have tied each shape to its own cell, as, and this is where I am stuck, I planned to use this VBA code to change the shape colour based on the number in the cell:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim shp As Shape, r As Long, g As Long, b As Long

Code:
Dim shp As Shape, r As Long, g As Long, b As Long

With Sheet1
For Each shp In .Shapes
With shp.TextFrame
Select Case .Characters.Text
Case "1"
r = 255
g = 0
b = 0
Case "2"
r = 0
g = 255
b = 0
End Select
End With
shp.Fill.ForeColor.RGB = RGB(r, g, b)
Next shp
End With

BUT, I cannot get it to work for one shape, let alone all 50 something there are! Please can you help me. Tell me if I am wrong totally or just missing one thing! Any help is greatly appreciated

 

[steve the fish]

If you click the shape i presume in the formula bar you see your target cell =$A$1 for example? If you do i cant see what that doesnt work.

 

[ialexander03]

Hi Steve,

Yes, the shapes all say their respective cells when clicked on

When I enter a value in the target cell, it goes to the debugging error, and highlights the "For Each shp In .Shapes" line

 

[steve the fish]

Look like its slightly different with freeform.

For Each shp In Shapes
    With shp.TextEffect
        Select Case .Text
            Case "1"
                r = 255
                g = 0
                b = 0
            Case "2"
                r = 0
                g = 255
                b = 0
        End Select
    End With
    shp.Fill.ForeColor.RGB = RGB(r, g, b)
Next shp

 

[ialexander03]

Hi Steve,

I am now getting a runtime debugging error - -2147024809(80070057) The Specified Value is out of Range and it hightlights the line " With shp.TextEffect"

 

[steve the fish]

What happens if you add a condition like testing the shape name?

For Each shp In Shapes
    If InStr(shp.Name, "Freeform") > 0 Then
        With shp.TextEffect
            Select Case .Text
                Case "1": r = 255: g = 0: b = 0
                Case "2": r = 0: g = 255: b = 0
            End Select
        End With
        shp.Fill.ForeColor.RGB = RGB(r, g, b)
    End If
Next shp

 

[ialexander03]

Well, now this is getting interesting!!

When I type the number in the box when just having, as per the code example, "FREEFORM", the whole lot change colour (so something is working!!) but then when I tie it specifically to 1 free form shape, for example, Freeform: Shape 28, the rest stay the same, that shape changes to black (black is not the colour of either 1 or 2!) then doesn't change at all, so the original idea to tie each shape to a cell, and then that cell either be 1 or 2, changing the colour accordingly to each shape depending of if its cell was a 1 or 2, is now not working