Help with loop to fill color of shapes (US map)

[harleyberger]

Working on a US map that shows media markets. Each media market is a shape and the shape name represents the market name (i.e. Pittsburgh).

I have 2 values for 210 media markets. I want to compare the 2 values for each media market and then fill the corresponding shape with either red or blue based on which value is larger.

I need help with a loop for this instead of writing individual code for each one like I am now....

Private Sub Worksheet_Calculate()

    If Range("AI2").Value > Range("AJ2").Value Then
        ActiveSheet.Shapes.Range(Array("ALBUQUERQUE")).Select
        With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(0, 0, 255)
        End With
        
    Else
    
        ActiveSheet.Shapes.Range(Array("ALBUQUERQUE")).Select
        With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(255, 0, 0)
        End With
        
    End If
    
    If Range("AI3").Value > Range("AJ3").Value Then
        ActiveSheet.Shapes.Range(Array("BOSTON")).Select
        With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(0, 0, 255)
        End With
        
    Else
    
        ActiveSheet.Shapes.Range(Array("BOSTON")).Select
        With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(255, 0, 0)
        End With
        
    End If
    
    If Range("AI4").Value > Range("AJ4").Value Then
        ActiveSheet.Shapes.Range(Array("BUFFALO")).Select
        With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(0, 0, 255)
        End With
        
    Else
    
        ActiveSheet.Shapes.Range(Array("BUFFALO")).Select
        With Selection.ShapeRange.Fill
                .ForeColor.RGB = RGB(255, 0, 0)
        End With
        
    End If

End Sub

My media market names are in AH2:AH211 and the corresponding values for each market are in AI2:AJ211.

I'd like the code to look at each media market name, compare the values, and then fill the corresponding shape with either red or blue.

 

[Domenic]

Try...

[font=Courier New][color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_Calculate()

    [color=darkblue]Dim[/color] MyCity [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    LastRow = Cells(Rows.Count, "AH").End(xlUp).Row
    
    [color=darkblue]For[/color] i = 2 [color=darkblue]To[/color] LastRow
        MyCity = Cells(i, "AH").Value
        [color=darkblue]If[/color] MyCity <> "" [color=darkblue]Then[/color]
            [color=darkblue]If[/color] Cells(i, "AI").Value > Cells(i, "AJ").Value [color=darkblue]Then[/color]
                ActiveSheet.Shapes(MyCity).Fill.ForeColor.RGB = RGB(0, 0, 255)
            [color=darkblue]Else[/color]
                ActiveSheet.Shapes(MyCity).Fill.ForeColor.RGB = RGB(255, 0, 0)
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i


[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]