VBA select shapes based on their positions

13,638

Solution 1

Just as an alternative, you can reverse the logic and select as you go, then assign the selection to a shaperange if required:

Sub ShapePicker()
    Dim s As Shape
    Dim sr As ShapeRange
    Dim i As Long

    i = 1
    For Each s In ActiveSheet.Shapes
        If Cells(s.TopLeftCell.Row, "A").Value = 0 Then
            s.Select (i = 1)
            i = i + 1
        End If
    Next s
    Set sr = Selection.ShapeRange
End Sub

Solution 2

Build a ShapeRange that meets the criteria and then Select that ShapeRange

Sub ShapePicker()
    Dim s As Shape, sr As ShapeRange
    Dim Arr() As Variant
    Set mycell = Range("A:A").Find(What:=0, After:=Range("A1"))
    rrow = mycell.Row

    i = 1
    For Each s In ActiveSheet.Shapes
        If s.TopLeftCell.Row = rrow Then
            ReDim Preserve Arr(1 To i)
            Arr(i) = s.Name
            i = i + 1
        End If
    Next s

    Set sr = ActiveSheet.Shapes.Range(Arr)
    sr.Select

End Sub
Share:
13,638
Ivan Fazaniuk
Author by

Ivan Fazaniuk

Updated on June 14, 2022

Comments

  • Ivan Fazaniuk
    Ivan Fazaniuk almost 2 years

    How do I select all shapes (array? range?) where the value in Cell "A:Shape.TopLeftCell.Row" = 0 ? enter image description here

    The Array should consist only Shapes 2 and 3 as per image above.