I am struggling to figure out why I get the above error when I run this code. Sometimes it works, sometimes it doesn't? The code sits in a sheet rather than a module and I suspect that may be the problem, but the same piece of code runs fine in another sheet in the workbook.
Please can someone tell me what I am missing?
Thanks.
Sub DeleteRow()
On Error GoTo error_handler
Dim Button As Shape
Dim CellinRowtoDelete As Range
'Run sub routine
ClearSearchandFilter
Application.ScreenUpdating = False
'Determine which row needs to be deleted
ButtonLocation = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
Range(ButtonLocation).Select
'Select and delete buttons before deleting the row
Set CellinRowtoDelete = ActiveCell
For Each Button In ActiveSheet.Shapes
If Not Application.Intersect(Range(Button.TopLeftCell.Address), CellinRowtoDelete) Is Nothing Then
Button.Select
Button.Delete
End If
Next
'Delete the row
ActiveCell.EntireRow.Delete
'Re-format cells in row 8 with a red box incase the bottom has been removed by deleting row 9
Range("W8:AM8").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = -16776961
.TintAndShade = 0
.Weight = xlMedium
End With
Range("X5").Select
Application.ScreenUpdating = True
Exit Sub
Error_handler:
MsgBox Err.Description
End Sub
First off, you really should not use .Select
, .Activate
, or anything Active
, really. It will mess up your code more than it will help it (except for very few instances).
Second, instead of checking the intersection with a cell, try checking the intersection against the whole row. Since you're deleting all of the buttons in that row anyway (if I got you correctly), this will be more exact as even an off-cell-center will be deleted. This might sound confusing but bear with me.
Kindly try the following code.
Sub DeleteRow()
Dim Button As Shape
Dim RowToDelete As Range
'Run sub routine
ClearSearchandFilter
Application.ScreenUpdating = False
'Determine which row needs to be deleted
ButtonLocation = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address
Set RowToDelete = Range(ButtonLocation).EntireRow
'Select and delete buttons before deleting the row
For Each Button In ActiveSheet.Shapes
If Not Application.Intersect(Range(Button.TopLeftCell.Address), RowToDelete) Is Nothing Then
Button.Delete
End If
Next
'Delete the row
RowToDelete.Delete
'Re-format cells in row 8 with a red box incase the bottom has been removed by deleting row 9
With Range("W8:AM8").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Color = -16776961
.TintAndShade = 0
.Weight = xlMedium
End With
Application.ScreenUpdating = True
End Sub
Let us know what's the result.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.