Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$X$5" Then
Call Update_Map
End If
End Sub
Sub Update_Map()
Application.ScreenUpdating = False
Worksheets("Map Feed").Activate
Call ChangeColor
Worksheets("MainMap").Activate
Dim intState As Integer
Dim strStateName As String
Dim intStateValue As Variant
Dim intColorLookup As Variant
Dim rngStates As Range
Dim rngColors As Range
Set rngStates = Range(ThisWorkbook.Names("STATES").RefersTo)
Set rngColors = Range(ThisWorkbook.Names("STATE_COLORS").RefersTo)
With Worksheets("MainMap")
For intState = 1 To rngStates.Rows.Count
strStateName = rngStates.Cells(intState, 1).Text
intStateValue = rngStates.Cells(intState, 2).Value
intColorLookup = Application.WorksheetFunction.Match(intStateValue, Range("STATE_COLORS"), 0)
With .Shapes(strStateName)
.Fill.Solid
.Fill.ForeColor.RGB = rngColors.Cells(intColorLookup, 1).Offset(0, 1).Interior.Color
End With
Next
End With
Application.ScreenUpdating = True
End Sub
Sub ChangeColor()
Dim LastRow As Long
Dim FullRange As Variant
Dim cell As Variant
'Populate State Fill Color for metrics where higher is worse
If ActiveWorkbook.Worksheets("Map Feed").Range("B1").Value = "CPQ" Or _
ActiveWorkbook.Worksheets("Map Feed").Range("B1").Value = "Acq. Cost" Or _
ActiveWorkbook.Worksheets("Map Feed").Range("B1").Value = "CPMCP" Or _
ActiveWorkbook.Worksheets("Map Feed").Range("B1").Value = "%RDC D" Then
With ActiveSheet
LastRow = Range("C" & Rows.Count).End(xlUp).Row
End With
Set FullRange = Range("C2:C" & LastRow)
For Each cell In FullRange
If cell.Value = 0 Then cell.Interior.Color = RGB(255, 255, 255)
If cell.Value > 0 And cell.Value < 0.1 Then cell.Interior.Color = RGB(0, 76, 0)
If cell.Value >= 0.1 And cell.Value < 0.2 Then cell.Interior.Color = RGB(118, 147, 60)
If cell.Value >= 0.2 And cell.Value < 0.3 Then cell.Interior.Color = RGB(179, 203, 127)
If cell.Value >= 0.3 And cell.Value < 0.4 Then cell.Interior.Color = RGB(216, 228, 188)
If cell.Value >= 0.4 And cell.Value < 0.5 Then cell.Interior.Color = RGB(235, 241, 222)
If cell.Value >= 0.5 And cell.Value < 0.6 Then cell.Interior.Color = RGB(242, 220, 219)
If cell.Value >= 0.6 And cell.Value < 0.7 Then cell.Interior.Color = RGB(230, 184, 183)
If cell.Value >= 0.7 And cell.Value < 0.8 Then cell.Interior.Color = RGB(218, 150, 148)
If cell.Value >= 0.8 And cell.Value < 0.9 Then cell.Interior.Color = RGB(150, 54, 52)
If cell.Value >= 0.9 Then cell.Interior.Color = RGB(99, 37, 35)
Next
Else
With ActiveSheet
LastRow = Range("C" & Rows.Count).End(xlUp).Row
End With
Set FullRange = Range("C2:C" & LastRow)
For Each cell In FullRange
If cell.Value = 0 Then cell.Interior.Color = RGB(255, 255, 255)
If cell.Value > 0 And cell.Value < 0.1 Then cell.Interior.Color = RGB(99, 37, 35)
If cell.Value >= 0.1 And cell.Value < 0.2 Then cell.Interior.Color = RGB(150, 54, 52)
If cell.Value >= 0.2 And cell.Value < 0.3 Then cell.Interior.Color = RGB(218, 150, 148)
If cell.Value >= 0.3 And cell.Value < 0.4 Then cell.Interior.Color = RGB(230, 184, 183)
If cell.Value >= 0.4 And cell.Value < 0.5 Then cell.Interior.Color = RGB(242, 220, 219)
If cell.Value >= 0.5 And cell.Value < 0.6 Then cell.Interior.Color = RGB(235, 241, 222)
If cell.Value >= 0.6 And cell.Value < 0.7 Then cell.Interior.Color = RGB(216, 228, 188)
If cell.Value >= 0.7 And cell.Value < 0.8 Then cell.Interior.Color = RGB(179, 203, 127)
If cell.Value >= 0.8 And cell.Value < 0.9 Then cell.Interior.Color = RGB(118, 147, 60)
If cell.Value >= 0.9 Then cell.Interior.Color = RGB(0, 76, 0)
Next
End If
End Sub
Each macro runs smoothly on its own, so I'm thinking this may be some issue with a setting or something along those lines. Any of you gurus out there have any recommendations?
Bookmarks