Consider:
Sub ShapePicker() Dim sh As Shape, st As Variant, Llist As String Dim ty As String Dim nm As String Dim r As Range Dim ary As Variant For Each sh In ActiveSheet.Shapes ty = sh.Type nm = sh.name Set r = sh.TopLeftCell If ty = msoOLEControlObject Then If Not Intersect(r, Selection) Is Nothing Then If Llist = "" Then Llist = nm Else Llist = Llist & "," & nm End If End If End If Next sh ary = Split(Llist, ",") ActiveSheet.Shapes.Range((ary)).Select End Sub