Map data to map of USA

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I would like to map 50 pieces of data to the states on a map of the USA &
then to fill each state with a color, increasing in intensity as the number
rises. Does this sound like something that can be done in Excel?
 
Hi - thank you for your reply. Unfortunately I think the software is
probably not an option for us right now, however, your map looks like it
could be just what I'm looking for.

However, I need to have a far larger range of values, & possibly to
sub-group them, eg. 0-20, 21-40, etc. Can you give me any tips? So far I
haven't been able to work out how to extend your value & colour columns
beyond the 11 rows you've created.

Thanks!
 
Hi,

Use the revised routine below inconjunction with a new set of values in
the named range STATE_COLOURS. So a state with a value between 0 and 5
will be coloured with whatever colour you use in cell G2.

You can add more colours by extended the named range.

F2: =0
F3: =6
F4: =11
F5: =16
F6: =21
F7: =26
F8: =31
F9: =36
F10: =41
F11: =46

'---------------------------
Sub ColourStates()
'
' Using the values from named range STATE
' And the colours from named range STATE_COLOURS
' re colour the map on sheet MainMap
'
Dim intState As Integer
Dim strStateName As String
Dim intStateValue As Integer
Dim intColourLookup As Integer
Dim rngStates As Range
Dim rngColours As Range

Set rngStates = Range(ThisWorkbook.Names("STATES").RefersTo)
Set rngColours = Range(ThisWorkbook.Names("STATE_COLOURS").RefersTo)

With Worksheets("MainMap")
For intState = 1 To rngStates.Rows.Count
strStateName = rngStates.Cells(intState, 1).Text
intStateValue = rngStates.Cells(intState, 2).Value
intColourLookup =
Application.WorksheetFunction.Match(intStateValue,
Range("STATE_COLOURS"), True)
With .Shapes(strStateName)
.Fill.Solid
.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup,
1).Offset(0, 1).Interior.Color
End With
Next
End With

End Sub
'---------------------------

If you need more assistance then email me direct.

Cheers
Andy
 
Back
Top