Select a Shape that Intersects (touches) a Cell (range) using VBA

[michaelch2934]

Using VBA code, I will be placing a shape somewhere within a large cell range. But FIRST I NEED TO REMOVE THE SHAPE that may already be there. I know the shape will intersect or touch a certain cell (G13). So, I need the code to simply select this shape and then, I can move it to another location on the sheet. Because there are other shapes on the same sheet, I can't do a general 'select all' command. Just the shape that intersects G13. Thanks in advance.

 

[michaelch2934]

YES!!! This works very well for my intended purposes. Thank you so very much. Because I originally placed the shape 'over' G13, I know that by using G13 as the locus point, it will always 'find' the shape when it needs to be removed.

 

[ravisingh]

YES!!! This works very well for my intended purposes. Thank you so very much. Because I originally placed the shape 'over' G13, I know that by using G13 as the locus point, it will always 'find' the shape when it needs to be removed.

Hi ​michaelch2934
If you would reply with a quote, we would know which piece of code worked for you.
Regards
Ravi Singh

 

[michaelch2934]

I have just reread your post and you wanted to MOVE not delete. oops

Here is a code which
- counts how many shapes intersect cell G13
- selects a shape so that it can be moved

Sub IsThereAShapeToMove()
    Dim shp As Shape, shpRng As Range, c As Integer
    With ActiveSheet
        For Each shp In .Shapes
            Set shpRng = .Range(shp.TopLeftCell.Address, .Range(shp.BottomRightCell.Address))
            If Not Intersect(shpRng, .Range("G13")) Is Nothing Then
                c = c + 1: shp.Select
            End If
        Next shp
    End With
    If c > 1 Then MsgBox c & " intersecting shapes"
End Sub

This piece of code works very well for my intended purposes. Thanks to everyone who contributed to this posting.

 

[ravisingh]

This piece of code works very well for my intended purposes. Thanks to everyone who contributed to this posting.

 

[michaelch2934]

Hi ​michaelch2934
If you would reply with a quote, we would know which piece of code worked for you.
Regards
Ravi Singh

Sub IsThereAShapeToMove()
Dim shp As Shape, shpRng As Range, c As Integer
With ActiveSheet
For Each shp In .Shapes
Set shpRng = .Range(shp.TopLeftCell.Address, .Range(shp.BottomRightCell.Address))
If Not Intersect(shpRng, .Range("G13")) Is Nothing Then
c = c + 1: shp.Select
End If
Next shp
End With
If c > 1 Then MsgBox c & " intersecting shapes"
End Sub

This worked very well! Thank you all very much!!

 

[Yongle]

Thanks for your feedback