VBA bug in delete row code (with buttons)

[dannyok90]

Hi all,


Im having some intermitant trouble with the followin code (line where i've put the arrow)


The code sometimes breaks here and i have to close the spreadsheet and reopen it.. it works fine after that.. until it does it again.


Any ideas?


Thanks,
Dan

Option Explicit
Sub deletebutton()
    ' RSE Controls
    Dim delrng As Range
    Dim rngOld As Range
    Dim msgRes As VbMsgBoxResult
    Dim BTN As Shape
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Set rngOld = ActiveCell
    Set delrng = ActiveSheet.Shapes(Application.Caller).TopLeftCell.EntireRow
    msgRes = MsgBox("This action can't be undone." & vbNewLine & "Are you sure you want to proceed?", vbOKCancel, "Delete Row.")
    If msgRes = vbOK Then
    Sheet1.Unprotect Password:="rse1"
    For Each BTN In ActiveSheet.Shapes
    If Not Intersect(delrng, BTN.TopLeftCell) Is Nothing Then BTN.Delete        '<=================
Next
    delrng.Select
    delrng.Delete
    Sheet1.Protect Password:="rse1"
    End If
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub