Create Color coded USA map in Excel

[Bryant]

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.

[Jacques25]

You can take reference from the below code, to set the outline range of the USA map.

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

[Vandam]

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.

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

[Villiers]

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.

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

[Ronchi]

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.

[Shreevats]

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.

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

[Steyn]

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:

ActiveSheet.Shapes("Rectangle 1").Select
Selection.Characters.Text = "abc"