Create Color coded USA map in Excel
I have windows XP operating system and my requirement is that want to upload a map of the USA in excel and after that color code each state based on list of states including their corresponding revenue. What are the steps for it? Do I need any plug-in or add-in. Can anyone help me? I am waiting for you reply.
Re: Create Color coded USA map in Excel
You can take reference from the below code, to set the outline range of the USA map.
Code:
Function ColorIndex(rng As Range, _
Optional text As Boolean = False) As Variant
'---------------------------------------------------------------------
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim iWhite As Long, iBlack As Long
Dim aryColours As Variant
If rng.Areas.Count > 1 Then
ColorIndex = CVErr(xlErrValue)
Exit Function
End If
iWhite = WhiteColorindex(rng.Worksheet.Parent)
iBlack = BlackColorindex(rng.Worksheet.Parent)
If rng.Cells.Count = 1 Then
If text Then
aryColours = DecodeColorIndex(rng, True, iBlack)
Else
aryColours = DecodeColorIndex(rng, False, iWhite)
End If
Else
aryColours = rng.Value
i = 0
For Each row In rng.Rows
i = i + 1
j = 0
For Each cell In row.Cells
j = j + 1
If text Then
aryColours(i, j) = _
DecodeColorIndex(cell,True,iBlack)
Else
aryColours(i, j) = _
DecodeColorIndex(cell,False,iWhite)
End If
Next cell
Next row
End If
ColorIndex = aryColours
End Function
Re: Create Color coded USA map in Excel
I would like to add on the above code. The steps wise code for WhiteColorindex, BlackColorindex, DecodeColorIndex are as follows. Its very easy to understand and use it. I hope it works for you.
Code:
Private Function WhiteColorindex(oWB As Workbook)
'---------------------------------------------------------------------
Dim iPalette As Long
WhiteColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &HFFFFFF Then
WhiteColorindex = iPalette
Exit Function
End If
Next iPalette
End Function
'---------------------------------------------------------------------
Private Function BlackColorindex(oWB As Workbook)
'---------------------------------------------------------------------
Dim iPalette As Long
BlackColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &H0 Then
BlackColorindex = iPalette
Exit Function
End If
Next iPalette
End Function
'---------------------------------------------------------------------
Private Function DecodeColorIndex(rng As Range, _
text As Boolean, _
idx As Long)
'---------------------------------------------------------------------
Dim iColor As Long
If text Then
iColor = rng.font.ColorIndex
Else
iColor = rng.Interior.ColorIndex
End If
If iColor < 0 Then
iColor = idx
End If
DecodeColorIndex = iColor
End Function
Re: Create Color coded USA map in Excel
The below is the Script that I have used to color the shades in the map. I am sure it will work because I have personally tried it. You can have the necessary help from it.
Code:
Sub MapColorChange()
For i = 2 To 52
Range("actReg").Value = Range("ColorSelector!B" & i).Value
Sheets("MapSheet").Shapes(Range("actReg").Value).Select
Selection.ShapeRange.Fill.ForeColor.RGB = Range(Range("actRegCode").Value).Interior.Color
Next i
Range("A1").Select
Re: Create Color coded USA map in Excel
To create a map of USA with color coding you need to have excel in your computer and in that BeGraphic add-in. Then the next important step is that you need to have outline of the USA map. You will get this from the internet. Search over the internet for outline of USA map then proceed with the other steps for coloring the different shapes in the map.
Re: Create Color coded USA map in Excel
The following script will create "patterned thematic map" which uses the patterns from the legend. To proceed further create a colored thematic map and for that follow the below script.
Code:
In macro DefColorCodes() find the line:
Selection.ShapeRange.Fill.ForeColor.RGB = Range(Range("actRegCode").Value).Interior.Color
And Replace it with the below code:
Selection.ShapeRange.Fill.Patterned Range(Range("actRegCode").Value).Interior.Pattern
Re: Create Color coded USA map in Excel
Take any Polygon and then right click on it, there you will find the option to add text. The below I have mentioned the action and it looks like:
Code:
ActiveSheet.Shapes("Rectangle 1").Select
Selection.Characters.Text = "abc"