Search code examples
vbaexcelruntime-error

Excel Automation Error: Run-time error '-2147417848 (80010108)'

I am new to VBA (and Excel for that matter) so please keep that in mind when reviewing my code. This is also my first post here!

I am trying to complete and refine my file, but I have run into a error that I cannot seem to fix or even understand. I have searched this site (and many others) and found many people with this same error, but their resolutions are irrelevant and/or don't solve my problem.

This is the error I receive:

Error Message

"Automation Error. The object invoked has disconnected from its clients."

If I click debug, end, or help, Excel crashes and (sometimes) reopens an recovered file. SO frustrating!

I have managed to locate the line of code that causes this:

templateSheet.Copy After:=indexSheet

templateSheet and indexSheet are defined references to specific worksheets

The gist of what happens within this part of my file:

I've created a userform and a form control button. The button shows the userform. The userform has two fields asking the user to enter names. The code (all in the userform) checks all worksheet names.

  1. If the name exists, it tells the user to choose a different name.
  2. If the name doesn't exist, a hidden template sheet (templateSheet) is copied and pasted after the homepage sheet (indexSheet) and renamed based on the user input.
  3. A table on the homepage gets a new row and a hyperlink to the new sheet is added.
  4. There is additional code that adds values to cells on multiple sheets and formats that text.

All of this works perfectly for 21 runs. On the 22nd run, without fail, the automation error pops up and Excel crashes.

This happens on windows with Excel 2010, 2011, and 2016 (I've yet to test other versions on Excel) on a range of Windows versions. Bizzarly, the file works PERFECTLY on my 2013 MacBook pro with Excel 2011.. no errors at all.

The code I provide at the end of this post is the majority of the code within the file. At first, I thought it may be a memory issue but I think this is a pretty simple file, something excel and my desktop should be able to handle.

What I've done so far to try to fix it:

  • Option explicit
  • Keep templateSheet visible at all times
  • Create a separate Excel template file and call that from the userform
  • Changed .Activate and .Select to defined ranges
  • Copy and paste the new template sheet without specifying where to put it
  • Made sure all calls to sheets included specific "path" (ThisWorkbook.)

Inefficient workaround:

The only thing that prevents this error is code to save, close, and reopen the file. Obviously, this is time consuming and not efficient. I found this code online:

    wb.Save
    Application.OnTime Now + TimeValue("00:00:01"), Application.Workbooks.Open(filePath)
    wb.Close (True)

Finally:

As I stated, I am new to VBA, coding, and this site. Any suggestions to my code, relevant to this issue or not, are greatly appreciated. I have included all the code from my UserForm.

Private Sub OkButton_Click()

'Dont update the screen while the macro runs
Application.ScreenUpdating = False

    'Sheet and workbook variables
    Dim wb As Workbook
    Dim indexSheet As Worksheet, templateSheet As Worksheet
    Dim templateCopy As Worksheet, newSheet As Worksheet

    'Table and new row variables
    Dim Tbl As ListObject
    Dim NewRow As ListRow

    'Variables to group shapes based on
    'need to hide or show them
    Dim hideShapes() As Variant, showShapes() As Variant
    Dim hideGroup As Object, showGroup As Object

    'Misc variables
    Dim i As Integer
    Dim exists As Boolean
    Dim filePath As String

    'Variables to assign ranges
    Dim scenarioRng As Range
    Dim traceabilityFocus As Range
    Dim testCaseRng As Range
    Dim statusRng As Range
    Dim newSheetTestCaseRng As Range
    Dim newSheetStatusRng As Range
    Dim newSheetFocus As Range
    Dim newSheetDateRng As Range

    'Create array of shapes based on visibility rules
    hideShapes = Array("TextBox 2", "Rectangle 1")
    showShapes = Array("TextBox 15", "TextBox 14", "TextBox 13", "TextBox 11", "StatsRec", "Button 10")

    'To reference Traceability Matrix sheet
    Set indexSheet = ThisWorkbook.Sheets("Traceability Matrix")
    'To reference Template sheet
    Set templateSheet = ThisWorkbook.Sheets("TestCase_Template")
    'To reference traceability matrix table
    Set Tbl = indexSheet.ListObjects("TMatrix")
    'Set hideShapes to a hide group
    Set hideGroup = indexSheet.Shapes.Range(hideShapes)
    'Set show shapes to a show group
    Set showGroup = indexSheet.Shapes.Range(showShapes)
    'To reference this workbook
    Set wb = ThisWorkbook
    'Get file path of this workbook and set it to string
    filePath = wb.FullName


    'If the userform fields are empty then show error message
    If ScenarioNameBox.Value = "" Or TestCaseNameBox.Text = "" Then
            MsgBox ("Please complete both fields.")
    'If the userform fields are completed and a worksheet with
    'the same name exists, set boolean to true
    Else
        For i = 1 To Worksheets.Count
        If ThisWorkbook.Worksheets(i).Name = TestCaseNameBox.Value Then
            exists = True
    End If
    'Iterate through all worksheets
    Next i

    'If test case name already exists, show error message
    If exists Then
        MsgBox ("This test case name is already in use. Please choose another name.")
    'If test case name is unique, update workbook
    Else
        'Copy template sheet to after traceability matrix sheet
        templateSheet.Copy After:=indexSheet 'LOCATION OF ERROR!!!
        'Ensure template sheet is hidden
        templateSheet.Visible = False

        'To reference copy of template
        Set templateCopy = ThisWorkbook.Sheets("TestCase_Template (2)")

        'Rename template sheet to the test case name
        templateCopy.Name = TestCaseNameBox.Value
        'To reference re-named template sheet
        Set newSheet = ThisWorkbook.Sheets(TestCaseNameBox.Value)
        'Show new sheet
        newSheet.Visible = True

        'Set focus to traceability matrix
        Set traceabilityFocus = indexSheet.Range("A1")

        'Add a new row
        Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)

        'Set ranges for cells in traceability table
        Set scenarioRng = indexSheet.Range("B" & NewRow.Range.Row)
        Set testCaseRng = scenarioRng.Offset(0, 1)
        Set statusRng = testCaseRng.Offset(0, 1)

        'Set scenario cell with name and format
        With scenarioRng
            .FormulaR1C1 = ScenarioNameBox.Value
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set test case cell with name, hyperlink to sheet, and format
        With testCaseRng
            .FormulaR1C1 = TestCaseNameBox.Value
            .Hyperlinks.Add Anchor:=testCaseRng, Address:="", SubAddress:=newSheet.Name & "!A1", TextToDisplay:=newSheet.Name
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set trial status as Incomplete and format
        With statusRng
            'Set new test case to "Incomplete"
            .Value = "Incomplete"
            .Font.Name = "Arial"
            .Font.Size = 12
            .Font.Color = vbBlack
        End With

        'Show or hide objects
        hideGroup.Visible = False
        showGroup.Visible = True

        'Set ranges for cells in test case table
        Set newSheetTestCaseRng = newSheet.Range("C2")
        Set newSheetStatusRng = newSheet.Range("C12")
        Set newSheetDateRng = newSheet.Range("C5")

        'Insert test case name into table
        newSheetTestCaseRng.Value = TestCaseNameBox.Value
        'Add todays date to Date Created
        newSheetDateRng.Value = Date
        'Set status to "Incomplete"
        newSheetStatusRng.Value = "Incomplete"
        'End with cursor at beginning of table
        newSheet.Activate
        Range("C3").Activate


        'wb.Save
        'Application.OnTime Now + TimeValue("00:00:01"), Application.Workbooks.Open(filePath)
        'wb.Close (True)


        'Close the userform
        Unload Me

        End If

    End If

    'Update screen
    Application.ScreenUpdating = True

End Sub

===========================================================================

Update:

Using the code provided by @DavidZemens the error acts differently. Normally, the userform closes after each sheet is created. @DavidZemens suggested leaving the form open so the user can make as many sheets as they need in one go. This method allows me to create a seemingly unlimited amount of sheets WITHOUT error. Read: at the 22 sheet mark, there is no error.

However, if I manually close the userform after making more than 22 sheets and then reopen it to create a new sheet, the automation error pops up again and excel crashes.

The new code that causes this error is here:

 With templateSheet
        .Visible = xlSheetVisible
        .Copy Before:=indexSheet 'ERRORS HERE!!
        .Visible = xlSheetVeryHidden

Another thing worth mentioning: In the project explorer it lists all my sheets with their names. But, there are extra sheets in there that have the workbook icon next to them. I did not create any of there workbooks or worksheets and my macros do not create or even call any workbook other than ThisWorkbook.

Solution

  • I don't have any idea if this will solve the problem, but I tried to clean up the code a bit. See if this helps. I created about 28 sheets without any error.

    There is some consolidation/cleanup but I wouldn't expect that to be substantial. However, I did remove the call to Unload Me which isn't strictly necessary (the user can always close out of the form manually, and by omitting that line we also allow the user to create as many sheets as he or she wants without having to launch the form anew each time).

    Option Explicit
Private Sub OkButton_Click()

'Dont update the screen while the macro runs
Application.ScreenUpdating = False

    'Sheet and workbook variables
    Dim wb As Workbook
    Dim indexSheet As Worksheet, templateSheet As Worksheet
    Dim templateCopy As Worksheet, newSheet As Worksheet

    'Table and new row variables
    Dim Tbl As ListObject
    Dim NewRow As ListRow

    'Variables to group shapes based on
    'need to hide or show them
    Dim hideShapes() As Variant, showShapes() As Variant
    Dim hideGroup As Object, showGroup As Object

    'Misc variables
    Dim i As Integer
    Dim exists As Boolean
    Dim filePath As String

    'Variables to assign ranges
    Dim scenarioRng As Range
    Dim traceabilityFocus As Range
    Dim testCaseRng As Range
    Dim statusRng As Range
    Dim newSheetTestCaseRng As Range
    Dim newSheetStatusRng As Range
    Dim newSheetFocus As Range
    Dim newSheetDateRng As Range

    'Create array of shapes based on visibility rules
    hideShapes = Array("TextBox 2", "Rectangle 1")
    showShapes = Array("TextBox 15", "TextBox 14", "TextBox 13", "TextBox 11", "StatsRec", "Button 10")
    'To reference this workbook
    Set wb = ThisWorkbook
    'To reference Traceability Matrix sheet
    Set indexSheet = wb.Sheets("Traceability Matrix")
    'To reference Template sheet
    Set templateSheet = wb.Sheets("TestCase_Template")
    'To reference traceability matrix table
    Set Tbl = indexSheet.ListObjects("TMatrix")
    'Set hideShapes to a hide group
    Set hideGroup = indexSheet.Shapes.Range(hideShapes)
    'Set show shapes to a show group
    Set showGroup = indexSheet.Shapes.Range(showShapes)
    'Get file path of this workbook and set it to string
    filePath = wb.FullName

    'If the userform fields are empty then show error message
    If ScenarioNameBox.Value = "" Or TestCaseNameBox.Text = "" Then
            MsgBox "Please complete both fields."
            GoTo EarlyExit
    'If the userform fields are completed and a worksheet with
    'the same name exists, set boolean to true
    Else
        On Error Resume Next
        Dim tmpWS As Worksheet
        ' This will error if sheet doesn't exist
        Set tmpWS = wb.Worksheets(TestCaseNameBox.Value)
        exists = Not (tmpWS Is Nothing)
        On Error GoTo 0
    End If

    'If test case name already exists, show error message
    If exists Then
        MsgBox "This test case name is already in use. Please choose another name."
        GoTo EarlyExit
    'If test case name is unique, update workbook
    Else
        'Copy template sheet to after traceability matrix sheet
        With templateSheet
            .Visible = xlSheetVisible
            .Copy Before:=indexSheet
            .Visible = xlSheetVeryHidden
        End With
        Set newSheet = wb.Sheets(indexSheet.Index - 1)
        With newSheet
            newSheet.Move After:=indexSheet
            'Rename template sheet to the test case name
            .Name = TestCaseNameBox.Value
            'To reference re-named template sheet
            .Visible = True
            'Set ranges for cells in test case table
            Set newSheetTestCaseRng = .Range("C2")
            Set newSheetStatusRng = .Range("C12")
            Set newSheetDateRng = .Range("C5")

            'Insert test case name into table
            newSheetTestCaseRng.Value = TestCaseNameBox.Value
            'Add todays date to Date Created
            newSheetDateRng.Value = Date
            'Set status to "Incomplete"
            newSheetStatusRng.Value = "Incomplete"
            'End with cursor at beginning of table
            .Activate
            .Range("C3").Activate
        End With

        'Set focus to traceability matrix
        Set traceabilityFocus = indexSheet.Range("A1")
        'Add a new row
        Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
        'Set ranges for cells in traceability table
        Set scenarioRng = indexSheet.Range("B" & NewRow.Range.Row)
        Set testCaseRng = scenarioRng.Offset(0, 1)
        Set statusRng = testCaseRng.Offset(0, 1)

        'Set scenario cell with name and format
        With scenarioRng
            .FormulaR1C1 = ScenarioNameBox.Value
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set test case cell with name, hyperlink to sheet, and format
        With testCaseRng
            .FormulaR1C1 = TestCaseNameBox.Value
            .Hyperlinks.Add Anchor:=testCaseRng, Address:="", SubAddress:=newSheet.Name & "!A1", TextToDisplay:=newSheet.Name
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set trial status as Incomplete and format
        With statusRng
            'Set new test case to "Incomplete"
            .Value = "Incomplete"
            .Font.Name = "Arial"
            .Font.Size = 12
            .Font.Color = vbBlack
        End With

        'Show or hide objects
        hideGroup.Visible = False
        showGroup.Visible = True

        wb.Save
    End If

EarlyExit:
    'Update screen
    Application.ScreenUpdating = True

End Sub