Heat mapping with excel and VBA

ialexander03

New Member
Joined
Jun 9, 2017
Messages
12
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
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,216
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Jun 9, 2017
Messages
12
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
 
Last edited:

steve the fish

Well-known Member
Joined
Oct 20, 2009
Messages
8,216
Office Version
  1. 365
Platform
  1. Windows
Look like its slightly different with freeform.

Code:
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

New Member
Joined
Jun 9, 2017
Messages
12

ADVERTISEMENT

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

Well-known Member
Joined
Oct 20, 2009
Messages
8,216
Office Version
  1. 365
Platform
  1. Windows
What happens if you add a condition like testing the shape name?

Code:
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

New Member
Joined
Jun 9, 2017
Messages
12
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,228
Messages
5,594,935
Members
413,953
Latest member
Arthur1471

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top