Odd excel-vba run-time Error and won't delete existing sheet

Question

I am running into this VBA error and cannot figure out why I keep getting this error every third time I run the macro (The first two runs fine).

The error is:

"Run-Time error '-2147417848 (80010108)': Method 'Delete' of object'_Worksheet'failed"

The debugger points to the "Worksheets(ContentName).Delete" under Delete Contents Sheet if it already exists comment in the code.

The purpose of this code: To create a table of contents on one sheet that links to all the sheets in the workbook by the sheet names

I have a button created to run the macro again to update the table of contents as I add a new sheet.

Sub TableOfContents_Create()
'PURPOSE: Add a Table of Contents worksheets to easily navigate to any tab
'SOURCE: www.TheSpreadsheetGuru.com

Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String

'Inputs
  ContentName = "Job List"

'Optimize Code
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
  On Error Resume Next
    Worksheets("Job List").Activate
  On Error GoTo 0

  If ActiveSheet.Name = ContentName Then
    myAnswer = MsgBox("A worksheet named [" & ContentName & _
      "] has already been created, would you like to replace it?", vbYesNo)

    'Did user select No or Cancel?
      If myAnswer <> vbYes Then GoTo ExitSub

    'Delete old Contents Tab
       Worksheets(ContentName).Delete
  End If

'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet
  Set Content_sht = ActiveSheet

'Format Contents Sheet
  With Content_sht
    .Name = ContentName
    .Range("B2") = "Jobs"
    .Range("B2").Font.Bold = True
  End With

'Create Array list with sheet names (excluding Contents)
  ReDim myArray(1 To Worksheets.Count - 1)

  For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> ContentName Then
      myArray(x + 1) = sht.Name
      x = x + 1
    End If
  Next sht

'Alphabetize Sheet Names in Array List
  For x = LBound(myArray) To UBound(myArray)
    For y = x To UBound(myArray)
      If UCase(myArray(y)) < UCase(myArray(x)) Then
        shtName1 = myArray(x)
        shtName2 = myArray(y)
        myArray(x) = shtName2
        myArray(y) = shtName1
      End If
     Next y
  Next x

'Create Table of Contents
  For x = LBound(myArray) To UBound(myArray)
    Set sht = Worksheets(myArray(x))
    sht.Activate
    With Content_sht
      .Hyperlinks.Add .Cells(x + 2, 3), "", _
      SubAddress:="'" & sht.Name & "'!A1", _
      TextToDisplay:=sht.Name
      .Cells(x + 2, 2).Value = x
    End With
  Next x

Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit

'A Splash of Guru Formatting! [Optional]
  Columns("A:B").ColumnWidth = 3.86
  Range("B1").Font.Size = 18
  Range("B1:F1").Borders(xlEdgeBottom).Weight = xlThin

  With Range("B3:B" & x + 1)
    .Borders(xlInsideHorizontal).Color = RGB(255, 255, 255)
    .Borders(xlInsideHorizontal).Weight = xlMedium
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Color = RGB(255, 255, 255)
    .Interior.Color = RGB(91, 155, 213)
  End With

'Adjust Zoom and Remove Gridlines
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.Zoom = 130




'Pulls the name of the work book and displays it at the top
    With Content_sht
      .Name = ContentName
      .Range("B1") = ThisWorkbook.Name
      .Range("B1").Font.Bold = True
    End With


'Create a refresh button
    ActiveSheet.Buttons.Add(Range("G4").Left, Range("G4").Top, 90, 25).Select
    Selection.Name = "btnRefreshList"
    Selection.OnAction = "TableOfContents_Create"
    ActiveSheet.Shapes("btnRefreshList").Select
    With Selection
       .Characters.Text = "Refresh List"
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 12
        End With
    End With

'Create a New Job Button
    ActiveSheet.Buttons.Add(Range("G2").Left, Range("G2").Top, 90, 25).Select
    Selection.Name = "btnNewJob"
    Selection.OnAction = "NewJob"
    ActiveSheet.Shapes("btnNewJob").Select
    With Selection
       .Characters.Text = "New Job"
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 12
        End With
    End With

ExitSub:
'Optimize Code
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

End Sub


'Create a new job worksheet
Private Sub NewJob()
Dim ws1 As Worksheet
    Set ws1 = ThisWorkbook.Worksheets("Master")
    ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
End Sub

I can paste this code into a new empty workbook and run it over and over again without error. Either by running the macro or clicking the Refresh List button. I can change the names of the worksheet and it changes them in the list. New Job doesn't work because I don't have a Master sheet but I don't think that's your problem. Anything else you're doing different? EDIT - I can reproduce the error if Job List is the last sheet - you can't delete the last sheet, is that the problem? — mock_blatt
Thanks for the reply mock_blatt. The New Job button was suppose to copy a sheet that was already made named "Master" (so anything can be in that sheet). I know the error would pop up if the Job List is the last sheet, but I still have other sheets in the wookbook. I get the error as I click the "refresh button" any time more than two times and it crashes. — asdfasdf590
That's interesting. Could you try opening a brand new blank workbook and pasting your code over there? That's what I did and it works. If it crashes there too, we know it's something about your environment. If it doesn't, there's something else about that specific workbook. — mock_blatt

Mark Fitzgerald Mark Fitzgerald · Accepted Answer · 2017-02-10T06:22:10

I was going to comment that I couldn't reproduce the error but @mock_blatt gave me a clue that maybe the code was running in a Sheet module.

Created a new book with two sheets, renamed one to Job List and pasted your code into it's module. Had to add declaration for undefined myAnswer variable. Ran the code.

While you can close the workbook in which code is running it seems you can't delete a sheet from a Sub running in the sheet's code module

Move your code to a standard module and it should run OK.

Odd excel-vba run-time Error and won't delete existing sheet

1 Answers