Selecting Shapes With Variable Based On Worksheet Data

[svAndiamo]

I'm working on a macro that automatically highlights a map based on the data within my worksheet. There are 35 areas on my map each with their own shape that is named for the number of the map area (100, 110, 120 to 750, 760, 770).

I need to be able to select the shape corresponding to the area so I can properly format it...

Here's my code thus far:

BuyersMarket = ActiveSheet.Range("U2")
SellersMarket = ActiveSheet.Range("U3")

For Row = 3 To 37

    Area = Cells(Row, 2).Value
    Inventory = Cells(Row, 3).Value
    
   
If Inventory > BuyersMarket Then

    ActiveSheet.Shapes.Range(Array(Area)).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 128, 0)
        .Transparency = 0.5
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 128, 0)
        .Transparency = 0
    End With

ElseIf Inventory < SellersMarket Then

    ActiveSheet.Shapes.Range(Array("Area760")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0.5
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
    End With

Else

    ActiveSheet.Shapes.Range(Array("Area760")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 0)
        .Transparency = 0.5
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 0)
        .Transparency = 0
    End With

End If

Next

However, this part doesn't work:
"ActiveSheet.Shapes.Range(Array(Area)).Select"


So I need to know how to properly specify a variable that I can use to select the shape so that I can assign it the right color.

Any ideas?

[abousetta]

Hello and welcome to the forum,

Please take a few minutes to read the forum rules and add Code Tags around your vba code. Also where is your array I can't seem to find it in the code above.

abousetta

[svAndiamo]

Thanks for the reminder on code tags.

Since I posted, I figured out that is was an array issue, and I was able to setup an array the worked for my needs. Below is the code that solved the issue:

Sub ColorMap()

'Buyers Market is Green
'Sellers Market is Red
'Balanced Market is Yellow


Dim BuyersMarket, SellersMarket As Integer
Dim AreaArray() As String
Dim InventoryArray() As String

Dim Index As Integer
Dim Xrow As Integer
Dim Size As Integer
Dim Drawing As String
Dim Inventory As Integer


BuyersMarket = ActiveSheet.Range("R4") 'User defined variable in worksheet
SellersMarket = ActiveSheet.Range("R5") 'User defined variable in worksheet

Xrow = 5 'Setting the start point of the array to match the correct position on the worksheet.
Size = 1 'Starting size of the array.
Index = 0 'Tracking array process position.

ReDim AreaArray(Size) 'Redimension size of array
ReDim InventoryArray(Size) 'Redimension size of array

' // BUILD DATA ARRAY //

Do Until Cells(Xrow, 2).Value = "" 'Start at top of column, and continue until a blank cell

    Cells(Xrow, 2).Select 'Populate the arrays
    AreaArray(Index) = Cells(Xrow, 2).Value
    InventoryArray(Index) = Cells(Xrow, 3).Value
    
    Size = Size + 1 'Increase array size variable
    ReDim Preserve AreaArray(Size) ' Increase array sizes while preserving data
    ReDim Preserve InventoryArray(Size)
    Index = Index + 1
    Xrow = Xrow + 1
Loop

Xrow = 5 'Return to top data
Index = 0 ' Reset Index to prepare to process array data


' // MODIFY COLORING OF MAP

Do Until Size = 1 'Process data until array is reduce to 1 entry.
    
    On Error Resume Next
    
    ActiveSheet.Shapes.Range(Array(AreaArray(Index))).Select ' Select Drawing Element


    If InventoryArray(Index) >= BuyersMarket Then 'Color Green for Buyers, Red for Sellers, Yellow for Balanced

        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 128, 0)
            .Transparency = 0.5
            .Solid
        End With
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 128, 0)
            .Transparency = 0.9
        End With

    ElseIf InventoryArray(Index) <= SellersMarket Then

        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(192, 0, 0)
            .Transparency = 0.5
            .Solid
        End With
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(192, 0, 0)
            .Transparency = 0.9
        End With

    Else

        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 255, 0)
            .Transparency = 0.5
            .Solid
        End With
        With Selection.ShapeRange.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 255, 0)
            .Transparency = 0.9
        End With

    End If
    
    Index = Index + 1
    Xrow = Xrow + 1
    Size = Size - 1
    
Loop

CopyPasteSort 'Copy the data, paste it into another column on right of map and sort from high to low inventory

Cells(2, 2).Select 'Return to top of worksheet

End Sub