Map of USA text box font color - Andy Pope script amend

[tarek]

Team,

Andy Pope created a fantastic USA Interactive Map application (AJP Excel Information) which will allow users to color the states (each state resembled with an object) according to a data value in the range 0 to 9.

Based on Andy's map, I am building a dashboard to show revenues by state so I've created text boxes on top of each state object and linked the text box to cells in another sheet that hold $ value related to the particular state.

State map objects: each named in the state full name (example: California, Texas.. etc.)
State revenue text boxes: each named in the state abbreviation (example: CA, TX.. etc.)

I am attempting to amend Andy's script to give the ability to control the state revenue text box FONT color according to a data value in a range 0-9
The excel sheet (“Color_Control”) has the following defined ranges:
Name: COLOR_VALUE
Refers to: =COLOR_Control!$I$3:$I$12
Name: STATE_ABBREVIATION
Refers to: =COLOR_Control!$B$3:$C$50
Name: STATES
Refers to: =COLOR_Control!$D$3:$E$51

The map is placed in a sheet called “MainMap”


Here is the code from Andy's file"




'
' Written by Andy Pope © 2003
'
Option Explicit

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
If intStateValue > 9 Then
' stripped
With .Shapes(strStateName)
intColourLookup = Application.WorksheetFunction.Match(CInt(Left(CStr(intStateValue), 1)), Range("STATE_COLOURS"), True)
.Fill.Patterned msoPatternWideUpwardDiagonal
.Fill.ForeColor.RGB = rngColours.Cells(intColourLookup, 1).Offset(0, 1).Interior.Color
intColourLookup = Application.WorksheetFunction.Match(CInt(Right(CStr(intStateValue), 1)), Range("STATE_COLOURS"), True)
.Fill.BackColor.RGB = rngColours.Cells(intColourLookup, 1).Offset(0, 1).Interior.Color
End With
Else
' 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
End If
Next
End With

End Sub



Thank you in advance for all your help