Thematic map in excel

[JasonMallon]

Hi Everyone,
I have set up a basic macro with the help of this site and others, to map colours onto a map. However I keep getting run time error '1004' when I go to complete it. A VBA Macro for just one shape worked fine but it wont work when I try and loop it. Any suggestions would be great. Please see the code below and the file attached.

Sub Macro6()

For i = 1 To 5
Range("actCounty").Value = Range("Sheet2" & i).Value
ActiveSheet.Shapes(Range("actCounty").Value).Select
Selection.ShapeRange.Fill.ForeColor.RGB = Range(Range("actCountyCode").Value).Interior.Color
Next i

Range("B54").Select

End Sub

Thanks in advance,
Jason

 

[Hui]

Jason

Firstly, Welcome to the Chandoo.org Forums

Can you please post a sample file so we can see what your trying to do

 

[NARAYANK991]

Hi Jason ,

To add to what Hui has posted , when ever you post a question regarding error in VBA code , please see if it is possible to post the offending line of code , since this itself can be a pointer to the problem.

In your case , I think it is the following line :

Range("actCounty").Value = Range("Sheet2" & i).Value

where I have highlighted the possible reason for the error ; since i will have the value 1 in the first pass through the loop , the highlighted portion will resolve to :

Range("Sheet21").Value

which is not possible.

There are two ways to correct this :

1. Worksheets("Sheet2").Range("C" & i).Value

where I have put in the highlighted portion as an arbitrary column reference ; you will need to change this to suit your workbook data layout.

2. Range("Sheet2!" & "C" & i).Value

where again I have put in the highlighted portion as an arbitrary column reference. Remember to add the exclamation sign ! after the sheet name ; if your sheet name has an enclosed space character , you will need to use the single quote sign ' around the sheet name , as in :

Range("'New Sheet'!" & "C" & i).Value

Narayan

 

[JasonMallon]

Hi Guys,

Thanks for your help. Apologies I posted the file but I edited it and i must have not updated. Please see the file attached. Essentially each county is a shape and I am trying to map the % which in this case is penetration to each county. However I can do one shape manually but not a loop.

Thanks in advance for your help,

Jason

 

[Somendra Misra]

Hi Jason,

May be I am wrong, can you try below code by making Data sheet active

Sub Macro6()

Application.ScreenUpdating = False
For i = 2 To 27
Range("actCounty").Value = Range("A" & i).Value
ActiveSheet.Shapes(Range("actCounty").Value).Select
Selection.ShapeRange.Fill.ForeColor.RGB = Range(Range("actCountyCode").Value).Interior.Color
Next i

Range("B1").Select
Application.ScreenUpdating = True
End Sub

Regards,

 

[JasonMallon]

Hi SM,

Your a genius that solved it for me. Thanks a million.

Jason

 

[Tashi]

Hi..how can i make the shape file map to change color based on cell value.Code or steps would be helpful.Trying to make heat map based on sales or coverage value.
Thanks in advance.

 

[NARAYANK991]

Hi ,

Try this :

Public Sub ColorMap()
          Dim COLORS As Variant
          COLORS = Array(vbRed, vbGreen, vbBlue, vbYellow, vbBlack)
         
          For Each State In [States]
              stcode = State.Offset(, 1)
              stval = State.Offset(, 2)
             
              Select Case stval
                      Case Is < 200
                          clr = COLORS(0)
                      Case Is < 400
                          clr = COLORS(1)
                      Case Is < 600
                          clr = COLORS(2)
                      Case Is < 800
                          clr = COLORS(3)
                      Case Else
                          clr = COLORS(4)
              End Select
             
              shpname = "S_" & stcode
             
              Worksheets("Shape Map").Shapes(shpname).Fill.ForeColor.RGB = clr
          Next
End Sub

Here States is a named range , which refers to =calc!$B$3:$B$31

Narayan

 

[Tashi]

Hi again...I tried this code but somehow the link or error comes up.Kindly verify the steps and code if missed.The map color doesnt change based on cell value yet.
Many thanks again.

 

[NARAYANK991]

Hi ,

There are seven sisters in the north-east ; your map has only 6.

Narayan