I’m trying to figure out how to delete all buttons within a range. I’ve seen plenty of examples on how to delete all buttons within a sheet but not a range. I created a range variable the contains every possible occurance of a button (this is used to reinitialize a form of variable size). The problem is that range doesnt support the object .Shapes or .Buttons.
Set totalTable = Range(ActiveCell, ActiveCell.Cells(1000, 1000)) For Each gen_btn In totalTable.Shapes gen_btn.Delete Next
Any help would be appreciated. Also, I can’t use ActiveSheet becuase there are buttons which i want to keep and becuase the macro is called by a button. Hence the need for a range. Thank you.
This solution uses the
Intersect method to see whether the shape is in your range and deletes the shape if it is.
Sub Delete_Shapes_In_Range() Dim btn As Shape Dim totalTable As Range Set totalTable = Range(ActiveCell, ActiveCell.Cells(1000, 1000)) For Each btn In ActiveSheet.Shapes If Not Intersect(btn_rng, totalTable) Is Nothing Then btn.Delete Next btn End Sub
Note that this code will not only delete buttons, but will also delete other shapes. If this is a concern, you can add an
If statement to skip certain shapes. For example:
If Not btn.Name Like "Picture*" Then '<~~Will skip pictures
If Not btn.Name Like "*box*" Then '<~~Will skip textboxes
etc. This assumes that you haven’t renamed the shapes since creating them.
I’ll show you how to extract the “position” of a button (it’s not optimal, but it works). Up to you to adapt it to make it work as it should. This will dislpay the row and column of the top-left cell touched by each button (in the
ActiveSheet) in successive message boxes.
Sub Testing() For Each butt In ActiveSheet.Buttons MsgBox "Row : " & butt.TopLeftCell.Row & vbCrLf & "Column : " & butt.TopLeftCell.Column Next butt End Sub
The complete code:
Sub DeleteRangeButtons() rng = "A1:A10" ' Place range here. Dim btn As Button, ws As Worksheet For Each ws In ActiveWorkbook.Worksheets For Each btn In ws.Buttons If isinrange(btn.TopLeftCell.Row, btn.TopLeftCell.Column, rng) Then btn.Delete End If Next btn Next ws End Sub Function isinrange(x, y, rng) Cells(x, y).Activate If Intersect(ActiveCell, Range(rng)) Is Nothing Then isinrange = False Else isinrange = True End If End Function
Commenting on answer by ARich (which was useful to me) since I couldn’t add a comment directly. It misses setting btn_rng, but btn.TopLeftCell could be used instead.
Also, I prefer
btn.Type = msoPicture
btn.Name Like “Picture.
Here is my method based on that:
Public Sub DeleteIntersectingPictures(ByVal sheetToDeleteIn As Worksheet, ByVal rangeToLookIn As range) Dim noOfRowsInSheet As Long Dim pictureItem As Shape Dim pictureRange As range For Each pictureItem In sheetToDeleteIn.Shapes If pictureItem.Type = msoPicture Then Set pictureRange = sheetToDeleteIn.range( _ pictureItem.TopLeftCell.Address & ":" & pictureItem.BottomRightCell.Address) If Not Intersect(pictureRange, rangeToLookIn) Is Nothing Then Call pictureItem.Delete End If End If Next pictureItem End Sub