简体   繁体   中英

VBA Excel - Application-Defined or Object-Defined Error

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.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM