excelfreeformvba

Interactive map in Excel macro

I am having troubles with the coding above "9".

              Sub ColourStates()

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


            ' single colour
            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

Here is the link to the file itself: https://dl.dropboxusercontent.com/u/41007907/MapOfStates.xls

It works fine for values below 9, but I need it to work until 20.

Solution

  • Your array STATE_COLORS includes only values within 0 to 9 interval. Here are the steps you need to proceed with: 1) open excel file 2) go to Formulas Tag 3) click on the Name Manager 4) choose STATE_COLORS arrays 5) increase the values to 20

    Get back to me if you have any other questions.