Application Or Object Defined Error Deleting Worksheet Shapes

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,570
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I've run into a little stumbling block that I hope someone can assist with.
It the portion of code below, am copying an existing a worksheet and renaming it, and then with that new worksheet, trying to remove any buttons (shapes) on the page. This code used to work, but for some reason it has stopped. I'm here because I'm trying to figure out what might have changed.

Rich (BB code):
Sub dist_create()
'Stop
    Application.ScreenUpdating = False
    Dim filePath As String
    Dim tc As Boolean
    Dim CList(1 To 5) As String
    Dim rw As Integer
    Dim sh As Worksheet
    Dim bLeft, bRight, c As Range
    Dim arrFolders() As String
    Dim i As Integer
    Dim strPath As String
    
    'setup sheets staff
    'check if distributables have been prepared already

    mntxt = MonthName(Month(inq_date))
    daytext = WeekdayName(Weekday(inq_date), True)
    crtyr = Year(Now)
    filePath = distpath & crtyr & "\" & mntxt & "\" & Format(Day(inq_date), "00") & " " & UCase(daytext) & "\"
    nfn = "WS " & Format(inq_date, "dd-mmm-yy") & ".xlsx"
    
     'create and save new target workbook
    filePath = filePath & nfn
    If FileExists(filePath) = True Then Kill (filePath) 'delete previous file for now
        
    Workbooks.Add.SaveAs Filename:=filePath
    Set wb_daily = Workbooks(nfn)
    'copy sheets
    arrNames = Array("MASTER", "EVL", "EVE", "LWP", "WPL", "WPE", "RPL", "RPE", "HPL", "HPE", "BPL", "BPE", "CUL", "CUE2", "CUE1", "CWP", "CRP", "LSP")
    
'create raw sheets
'Stop
    For i = 0 To 17
        shnm = arrNames(i)
        Debug.Print shnm
        Set ssh = Nothing
        On Error Resume Next
        Set ssh = ThisWorkbook.Sheets("Master")
        On Error GoTo 0
        If Not ssh Is Nothing Then
            ssh.Copy After:=wb_daily.Sheets(1)
            ActiveSheet.Name = shnm
            'sheets are hidden
        End If
        If shnm <> "MASTER" Then
            With ActiveSheet
                .Unprotect
            'eliminate buttons
                With ActiveSheet.Columns("Q:AG")
                    For Each shp In .Parent.Shapes
                        If Not Intersect(shp.TopLeftCell, .Cells) Is Nothing Then shp.Delete
                    Next shp
                End With
                With ActiveSheet.Range("D1:R9")
                    For Each shp In .Parent.Shapes
                        If Not Intersect(shp.TopLeftCell, .Cells) Is Nothing Then shp.Delete
                    Next shp
                End With
            'eliminate staffing range
                .Columns("S:AG").Clear
                .Range("O4") = ActiveSheet.Name
                .Protect
            End With
        End If
    Next i
    ..  ..  ..

The line in red is leaving me with an "Application-Defined or Object-defined error". I can step through the code, and in this line, it will step through 4 deletes before it hits the error.

shnm = "EVL" (the newly created worksheet's name).
There are 3 shapes, 2 "buttons" and a 3 rectangle that partially obscures the buttons, in columns Q:AG.
The sheet is unprotected and visible. A second workbook is open, but it does not appear to be inadvertently being applied these changes.

Thoughts?
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Thoughts?
Let's isolate the problem.

Copy the sheet to a new workbook, in the new workbook with all the shapes run the following code.
When the error occurs, the shape you couldn't delete is selected.
Check what you see strange in that shape that is different from the other shapes.
If you don't see something different. Save the file and share it so I can review it.

VBA Code:
Sub delete_shape()
  Dim shp As Shape
  'eliminate buttons
  With ActiveSheet.Columns("Q:AG")
      For Each shp In .Parent.Shapes
          If Not Intersect(shp.TopLeftCell, .Cells) Is Nothing Then
            shp.Select
            shp.Delete
          End If
      Next shp
  End With
End Sub

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Hi Dante, my apologies for taking so long to acknowledge your contribution.
I tried your diagnostic, and discovered that the offending shape was a shape (that I use as a button) named "btn_staffEdit"
I can't see anything unusual with it, nor do I recall having done anything (intentionally) with this shape that may have messed it up. It's just been static until I had time to apply a macro to it.
I've attached the file to see if you can manage to see a problem. I appreciate your offering to do that for me.
 
Upvote 0
Hello Dante,
Having not received any reponse, is it safe to assume that you found no issue? Should I be looking for another cause?
 
Upvote 0
I missed my edit time window, so I add this ...
When I run this code, and it breaks on that line, in the immediate window I type '?shp.name'. It reveals "Drop Down 1". No idea what this is or where it is.
I see it in the selection pane, but hiding and unhiding it doesn't help me find it. This could be the culprit, but I don't know how to find this object to delete it.

EDIT: Nope, thats not it. It's a dropdown I have on some cells in the data portion of my worksheet. It can stay.
 
Upvote 0
You have shapes that are hidden so they cannot be selected or deleted.
First you need to make them visible:

For example:
VBA Code:
Sub delete_shape()
  Dim shp As Shape
  Dim k As Long
  'eliminate buttons
  For k = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(k).Visible = msoTrue
  Next k

  With ActiveSheet.Columns("Q:AG")
      For Each shp In .Parent.Shapes
          If Not Intersect(shp.TopLeftCell, .Cells) Is Nothing Then
            shp.Delete
          End If
      Next shp
  End With
End Sub
 
Upvote 1
Solution
Ahhh ... OK. I see. Thanks so much Dante, always appreciate your help.
 
Upvote 0

Forum statistics

Threads
1,223,879
Messages
6,175,150
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top