Run-time error '-2147417848 (80010108)': Automation error. The object invoked has disconnected from its clients.

J

Jefffey

New Member
Joined
Aug 4, 2015
Messages
2
So, I've got an issue with a macro I'm making. I get this error intermittently, maybe one out of three runs. Sometimes it will happen. Sometimes it won't. The error doesn't give me the debug option, so I'm not 100% sure what line is causing it. This is my first time writing a macro, so I apologize if it's messy. I've looked at every solution for this error I can find, but I can't find anything that solves my situation. This is being used for Windows 7/Excel 2013. The error occurs after the code is completed. I see the 100% completion bar. After I close out of the error excel crashes.

The macro accomplishes the following: allows a user to press a button to import data from external worksheets and creates a pivot table from said data.

Here's the main module:
Code: 
Option Explicit

Sub Import()


Dim count As Integer, GetBook As String, directory As String, sheet As Worksheet, fileName As String, counter2 As Integer, counter3 As Integer, overallrow As Integer, currentrow As Integer, lastcol As Integer, counter4 As Integer, delcount As Integer, placeholder2 As Integer, placeholder1 As String, hour As Integer, counter5 As Integer
Dim datecol As Integer, replacearray(0 To 11) As String, replacedarray(0 To 11) As String, groupname As String, math1 As Double, math2 As Double, math3 As Double, pctCompl As Single, lastrow2 As Integer, lastcol2 As Integer
Dim total As Integer, counter As Integer, lastrow As Integer, Ctrl As Office.CommandBarControl


'Initialize Loading Bar
UserForm1.Finish.Visible = False
pctCompl = 0
progress pctCompl
'Initialize Loading Bar


'Arrays to clean up dates with extra 0s
replacearray(0) = "01/"
replacearray(1) = "02/"
replacearray(2) = "03/"
replacearray(3) = "04/"
replacearray(4) = "05/"
replacearray(5) = "06/"
replacearray(6) = "07/"
replacearray(7) = "08/"
replacearray(8) = "09/"
replacearray(9) = "010/"
replacearray(10) = "011/"
replacearray(11) = "012/"


replacedarray(0) = "1/"
replacedarray(1) = "2/"
replacedarray(2) = "3/"
replacedarray(3) = "4/"
replacedarray(4) = "5/"
replacedarray(5) = "6/"
replacedarray(6) = "7/"
replacedarray(7) = "8/"
replacedarray(8) = "9/"
replacedarray(9) = "10/"
replacedarray(10) = "11/"
replacedarray(11) = "12/"
'Arrays to clean up dates with extra 0s


'Variable Initialization
count = 0
currentrow = 2


Application.ScreenUpdating = False
Application.DisplayAlerts = False


GetBook = ActiveWorkbook.Name


directory = Workbooks(GetBook).Worksheets("Table").Range("E5").Value
fileName = Dir(directory & "*.xl??")
'Variable Initialization


'Input custom list for date ordering
Dim CustomList As Integer
'Check if the list exists.
CustomList = Application.GetCustomListNum(Array(Workbooks(GetBook).Worksheets("Table").Range("C13").Value, Workbooks(GetBook).Worksheets("Table").Range("C14").Value, Workbooks(GetBook).Worksheets("Table").Range("C15").Value, Workbooks(GetBook).Worksheets("Table").Range("C16").Value, Workbooks(GetBook).Worksheets("Table").Range("C17").Value, Workbooks(GetBook).Worksheets("Table").Range("C18").Value, Workbooks(GetBook).Worksheets("Table").Range("C19").Value, Workbooks(GetBook).Worksheets("Table").Range("C20").Value, Workbooks(GetBook).Worksheets("Table").Range("C21").Value, Workbooks(GetBook).Worksheets("Table").Range("C22").Value, Workbooks(GetBook).Worksheets("Table").Range("C23").Value, Workbooks(GetBook).Worksheets("Table").Range("C24").Value, Workbooks(GetBook).Worksheets("Table").Range("C25").Value, Workbooks(GetBook).Worksheets("Table").Range("C26").Value, Workbooks(GetBook).Worksheets("Table").Range("C27").Value, Workbooks(GetBook).Worksheets("Table").Range("C28").Value, _
Workbooks(GetBook).Worksheets("Table").Range("C29").Value, Workbooks(GetBook).Worksheets("Table").Range("C30").Value, Workbooks(GetBook).Worksheets("Table").Range("C31").Value, Workbooks(GetBook).Worksheets("Table").Range("C32").Value, Workbooks(GetBook).Worksheets("Table").Range("C33").Value, Workbooks(GetBook).Worksheets("Table").Range("C34").Value, Workbooks(GetBook).Worksheets("Table").Range("C35").Value, Workbooks(GetBook).Worksheets("Table").Range("C36").Value, Workbooks(GetBook).Worksheets("Table").Range("C37").Value, Workbooks(GetBook).Worksheets("Table").Range("C38").Value))
 

'Exit if the list is already there.
If CustomList > 0 Then
Else
'Add the list if it does not exist.
    Application.AddCustomList (Array(Workbooks(GetBook).Worksheets("Table").Range("C13").Value, Workbooks(GetBook).Worksheets("Table").Range("C14").Value, Workbooks(GetBook).Worksheets("Table").Range("C15").Value, Workbooks(GetBook).Worksheets("Table").Range("C16").Value, Workbooks(GetBook).Worksheets("Table").Range("C17").Value, Workbooks(GetBook).Worksheets("Table").Range("C18").Value, Workbooks(GetBook).Worksheets("Table").Range("C19").Value, Workbooks(GetBook).Worksheets("Table").Range("C20").Value, Workbooks(GetBook).Worksheets("Table").Range("C21").Value, Workbooks(GetBook).Worksheets("Table").Range("C22").Value, Workbooks(GetBook).Worksheets("Table").Range("C23").Value, Workbooks(GetBook).Worksheets("Table").Range("C24").Value, Workbooks(GetBook).Worksheets("Table").Range("C25").Value, Workbooks(GetBook).Worksheets("Table").Range("C26").Value, Workbooks(GetBook).Worksheets("Table").Range("C27").Value, Workbooks(GetBook).Worksheets("Table").Range("C28").Value, _
    Workbooks(GetBook).Worksheets("Table").Range("C29").Value, Workbooks(GetBook).Worksheets("Table").Range("C30").Value, Workbooks(GetBook).Worksheets("Table").Range("C31").Value, Workbooks(GetBook).Worksheets("Table").Range("C32").Value, Workbooks(GetBook).Worksheets("Table").Range("C33").Value, Workbooks(GetBook).Worksheets("Table").Range("C34").Value, Workbooks(GetBook).Worksheets("Table").Range("C35").Value, Workbooks(GetBook).Worksheets("Table").Range("C36").Value, Workbooks(GetBook).Worksheets("Table").Range("C37").Value, Workbooks(GetBook).Worksheets("Table").Range("C38").Value))
End If


CustomList = Application.GetCustomListNum(Array(Workbooks(GetBook).Worksheets("Table").Range("C13").Value, Workbooks(GetBook).Worksheets("Table").Range("C14").Value, Workbooks(GetBook).Worksheets("Table").Range("C15").Value, Workbooks(GetBook).Worksheets("Table").Range("C16").Value, Workbooks(GetBook).Worksheets("Table").Range("C17").Value, Workbooks(GetBook).Worksheets("Table").Range("C18").Value, Workbooks(GetBook).Worksheets("Table").Range("C19").Value, Workbooks(GetBook).Worksheets("Table").Range("C20").Value, Workbooks(GetBook).Worksheets("Table").Range("C21").Value, Workbooks(GetBook).Worksheets("Table").Range("C22").Value, Workbooks(GetBook).Worksheets("Table").Range("C23").Value, Workbooks(GetBook).Worksheets("Table").Range("C24").Value, Workbooks(GetBook).Worksheets("Table").Range("C25").Value, Workbooks(GetBook).Worksheets("Table").Range("C26").Value, Workbooks(GetBook).Worksheets("Table").Range("C27").Value, Workbooks(GetBook).Worksheets("Table").Range("C28").Value, _
Workbooks(GetBook).Worksheets("Table").Range("C29").Value, Workbooks(GetBook).Worksheets("Table").Range("C30").Value, Workbooks(GetBook).Worksheets("Table").Range("C31").Value, Workbooks(GetBook).Worksheets("Table").Range("C32").Value, Workbooks(GetBook).Worksheets("Table").Range("C33").Value, Workbooks(GetBook).Worksheets("Table").Range("C34").Value, Workbooks(GetBook).Worksheets("Table").Range("C35").Value, Workbooks(GetBook).Worksheets("Table").Range("C36").Value, Workbooks(GetBook).Worksheets("Table").Range("C37").Value, Workbooks(GetBook).Worksheets("Table").Range("C38").Value))
'Input custom list for date ordering


'Clean up workbook
For Each sheet In Workbooks(GetBook).Worksheets
    If Not sheet.Name = "Table" And Not sheet.Name = "Data" Then
        sheet.Delete
    End If
Next sheet


Workbooks(GetBook).Worksheets(2).Cells.Clear
'Clean up workbook


'Set up headers
For counter2 = 1 To 25
    Workbooks(GetBook).Worksheets(2).Cells(1, counter2).Value = Workbooks(GetBook).Worksheets(1).Cells(12 + counter2, 5).Value
Next counter2
'Set up headers


'Import external worksheets
Do While fileName <> ""


    Workbooks.Open (directory & fileName)


    For Each sheet In Workbooks(fileName).Worksheets
        total = Workbooks(GetBook).Worksheets.count
        If sheet.Name = "1" Or sheet.Name = "2" Then
            Workbooks(fileName).Worksheets(sheet.Name).Copy _
            after:=Workbooks(GetBook).Worksheets(total)
            count = count + 1
        End If
    Next sheet


    Workbooks(fileName).Close


    fileName = Dir()
    
    pctCompl = pctCompl + 15
    progress pctCompl
Loop
'Import external worksheets


'Initialization for data importation
counter = count
lastrow = Workbooks(GetBook).Worksheets(3).Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
lastcol = Workbooks(GetBook).Worksheets(3).Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
lastrow2 = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
lastcol2 = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
'Workbooks(GetBook).Worksheets(1).Cells(20, 20).Value = lastcol
Workbooks(GetBook).Worksheets(2).Cells(1, lastcol2 + 1).Value = "CID/ACT"
'Initialization for data importation


'Move imported worksheet data to the data worksheet
Do While counter > 0
    For counter2 = 1 To lastcol
        If Workbooks(GetBook).Worksheets(2).Cells(1, counter2).Value = "hour" Or Workbooks(GetBook).Worksheets(2).Cells(1, counter2).Value = "Hour" Or Workbooks(GetBook).Worksheets(2).Cells(1, counter2).Value = "hours" Or Workbooks(GetBook).Worksheets(2).Cells(1, counter2).Value = "Hours" Then
            hour = counter2
        End If
    Next counter2


    For counter2 = 1 To lastrow
        For counter3 = 1 To lastcol
            If Workbooks(GetBook).Worksheets(3).Cells(counter2, counter3).Value = "AESM" Or Workbooks(GetBook).Worksheets(3).Cells(counter2, counter3).Value = "TERE" Or Workbooks(GetBook).Worksheets(3).Cells(counter2, counter3).Value = "MERE" Or Workbooks(GetBook).Worksheets(3).Cells(counter2, counter3).Value = "ESS" Then
                For counter4 = 1 To lastcol
                    Workbooks(GetBook).Worksheets(2).Cells(currentrow, counter4).Value = Workbooks(GetBook).Worksheets(3).Cells(counter2, counter4).Value
                    If Workbooks(GetBook).Worksheets(3).Name = "1" Then
                        Workbooks(GetBook).Worksheets(2).Cells(currentrow, lastcol2 + 1).Value = "ACWP"
                        placeholder2 = Val(Workbooks(GetBook).Worksheets(2).Cells(currentrow, hour).Value)
                        Workbooks(GetBook).Worksheets(2).Cells(currentrow, hour).Value = placeholder2 * -1
                    ElseIf Workbooks(GetBook).Worksheets(3).Name = "2" Then
                        Workbooks(GetBook).Worksheets(2).Cells(currentrow, lastcol2 + 1).Value = "EAC"
                    End If
                Next counter4
                currentrow = currentrow + 1
            End If
        Next counter3
    Next counter2


    Workbooks(GetBook).Worksheets(3).Delete


    pctCompl = pctCompl + 30 / count
    progress pctCompl


    counter = counter - 1
Loop
'Move imported worksheet data to the data worksheet


'Data formatting
For counter2 = 1 To lastcol
    If Workbooks(GetBook).Worksheets(2).Cells(1, counter2) = "Date" Then
       datecol = counter2
    End If
Next counter2


For counter2 = 1 To lastrow
    Workbooks(GetBook).Worksheets(2).Cells(counter2, datecol).Value = "" & Workbooks(GetBook).Worksheets(2).Cells(counter2, datecol).Value
Next counter2


pctCompl = 80


For counter2 = 0 To 11
    For counter3 = 1 To 2
        For counter4 = 1 To lastrow
            Workbooks(GetBook).Worksheets(2).Cells(counter4, datecol).Replace What:="/", Replacement:="-", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
        Next counter4
    Next counter3
Next counter2
'Data formatting


'Update loading bar
pctCompl = 90
progress pctCompl
'Update loading bar


' Creates a PivotTable report from the table on Sheet1
' by using the PivotTableWizard method with the PivotFields
' method to specify the fields in the PivotTable.
Dim objTable As PivotTable, objField As PivotField


' Select the sheet and first cell of the table that contains the data.
Workbooks(GetBook).Sheets("Data").Select
Range("A1").Select


' Create the PivotTable object based on the Employee data on Sheet1.
Set objTable = Workbooks(GetBook).Worksheets(2).PivotTableWizard


' Specify row and column fields.
Set objField = objTable.PivotFields("Group")
objField.Orientation = xlRowField
objField.Position = 1
Set objField = objTable.PivotFields("CID/ACT")
objField.Orientation = xlRowField
objField.Position = 2
Set objField = objTable.PivotFields("Date")
objField.Orientation = xlColumnField


' Specify a data field with its summary
' function and format.
Set objField = objTable.PivotFields("Hours")
objField.Orientation = xlDataField
'objField.Function = x1Sum


'Pivot Table Formatting
objTable.GrandTotalName = "Total"
objTable.PivotFields("Group").SubtotalName = _
    "? Delta"


Workbooks(GetBook).Worksheets(2).PivotTables(1).ColumnGrand = False
'Pivot Table Formatting


Application.DeleteCustomList CustomList


lastrow = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
lastcol = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column


Workbooks(GetBook).Worksheets(2).Name = "EAC Tool"


pctCompl = 80
progress pctCompl


'This inserts an event macro into the newly created pivot table worksheet
 Dim wb As Workbook, ws As Worksheet
    Dim VBP As Object, VBC As Object, CM As Object
    Dim strProcName As String


    Set wb = Workbooks(GetBook)
    Set ws = wb.Sheets(2)


    Set Ctrl = Application.VBE.CommandBars.FindControl(ID:=578)
    If Ctrl.Enabled = True Then Ctrl.Execute
    Set VBP = wb.VBProject
    Set VBC = VBP.VBComponents(ws.CodeName)
    Set CM = VBC.CodeModule


    strProcName = "Worksheet_PivotTableUpdate"


    With wb.VBProject.VBComponents( _
    wb.Worksheets(ws.Name).CodeName).CodeModule
        .InsertLines Line:=.CreateEventProc("PivotTableUpdate", "Worksheet") + 1, _
        String:=vbCrLf & _
        "    Application.Run GetBook & ""Format"""
    End With
    Application.VBE.MainWindow.Visible = False
'This inserts an event macro into the newly created pivot table worksheet


'Pivot table formatting for awhile
For counter2 = 1 To lastrow
    For counter3 = 1 To lastcol + 2
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).NumberFormat = "?#,###,###,###.00;?#,###,###,###.00"
    Next counter3
Next counter2


For counter2 = 5 To lastrow
    For counter3 = 3 To lastcol
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
            Formula1:="=0"
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions.count).SetFirstPriority
        With Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(1).Font
            .Color = -16752384
            .TintAndShade = 0
        End With
        With Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13561798
            .TintAndShade = 0
        End With
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(1).StopIfTrue = False
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
            Formula1:="=0"
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions.count).SetFirstPriority
        With Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(1).Font
            .Color = -16383844
            .TintAndShade = 0
        End With
        With Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).FormatConditions(1).StopIfTrue = False
    Next counter3


    counter2 = counter2 + 3


    If counter2 > lastrow Then
        For counter3 = 3 To lastcol
            Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
                Formula1:="=0"
            Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions.count).SetFirstPriority
            With Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(1).Font
                .Color = -16752384
                .TintAndShade = 0
            End With
            With Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 13561798
                .TintAndShade = 0
            End With
            Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(1).StopIfTrue = False
            Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
                Formula1:="=0"
            Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions.count).SetFirstPriority
            With Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(1).Font
                .Color = -16383844
                .TintAndShade = 0
            End With
            With Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 13551615
                .TintAndShade = 0
            End With
            Workbooks(GetBook).Worksheets(2).Cells(lastrow, counter3).FormatConditions(1).StopIfTrue = False
        Next counter3
    End If


    counter2 = counter2 - 1


Next counter2


For counter2 = 1 To lastcol + 2
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlDiagonalDown).LineStyle = xlNone
    Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlDiagonalUp).LineStyle = xlNone
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
Next counter2


For counter2 = 5 To lastrow
    For counter3 = 1 To lastcol
        With Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = 2
        End With
    Next counter3
    counter2 = counter2 + 2
Next counter2


For counter2 = 3 To lastrow
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, 2).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
Next counter2


For counter2 = 2 To lastrow
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, lastcol).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, lastcol).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
Next counter2


For counter2 = 1 To lastrow
    For counter3 = 1 To lastcol + 2
            With Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
    Next counter3
Next counter2


Workbooks(GetBook).Worksheets(2).Cells(1, 1).ColumnWidth = 12
Workbooks(GetBook).Worksheets(2).Cells(1, 2).ColumnWidth = 12


Workbooks(GetBook).Worksheets(2).Cells(2, lastcol).Insert
Workbooks(GetBook).Worksheets(2).PivotTables(1).PivotFields("Date").PivotItems( _
        "Formula1").Caption = ""


For counter2 = 2 To lastrow
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, lastcol + 1).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, lastcol).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
Next counter2


Workbooks(GetBook).Worksheets(2).Cells(2, lastcol + 2).Value = "CPI"
For counter2 = 5 To lastrow
    math1 = Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 1).Value
    math2 = Workbooks(GetBook).Worksheets(2).Cells(counter2 - 1, lastcol + 1).Value
    If math1 = 0 Or math2 = 0 Then
        math3 = 0
    Else
        math3 = math2 / math1
    End If




    Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 2).Value = math3
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 2).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 2).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 2).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 1).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    counter2 = counter2 + 2
Next counter2


Workbooks(GetBook).Worksheets(2).Cells(1, lastcol).ColumnWidth = 2.29
'Pivot table formatting for awhile


pctCompl = 100
progress pctCompl


'Show done button
UserForm1.Finish.Visible = True
'Show done button


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub
Sub progress(pctCompl As Single)


UserForm1.Text.Caption = pctCompl & "% Completed"
UserForm1.Bar.Width = pctCompl * 2


DoEvents


End Sub

The macro is called by a button with this code:
Code: 
Option Explicit


Sub CommandButton1_Click()


UserForm1.Show


End Sub

UserForm1 has the following code:
Code: 
Option Explicit


Private Sub UserForm_Activate()


Import


End Sub
Private Sub Finish_Click()


Unload Me


End Sub

I'm moderately confident that the error stems from my use of the extensibility library. When I create my pivot table in the main module I need to add an event macro to the new worksheet it is created on. I've posted the bit of code that does that from the main module below:
Code: 
'This inserts an event macro into the newly created pivot table worksheet
 Dim wb As Workbook, ws As Worksheet
    Dim VBP As Object, VBC As Object, CM As Object
    Dim strProcName As String


    Set wb = Workbooks(GetBook)
    Set ws = wb.Sheets(2)


    Set Ctrl = Application.VBE.CommandBars.FindControl(ID:=578)
    If Ctrl.Enabled = True Then Ctrl.Execute
    Set VBP = wb.VBProject
    Set VBC = VBP.VBComponents(ws.CodeName)
    Set CM = VBC.CodeModule


    strProcName = "Worksheet_PivotTableUpdate"


    With wb.VBProject.VBComponents( _
    wb.Worksheets(ws.Name).CodeName).CodeModule
        .InsertLines Line:=.CreateEventProc("PivotTableUpdate", "Worksheet") + 1, _
        String:=vbCrLf & _
        "    Application.Run GetBook & ""Format"""
    End With
    Application.VBE.MainWindow.Visible = False
'This inserts an event macro into the newly created pivot table worksheet

Here's the module that the worksheet macro references:
Code: 
Sub Format()


Dim lastrow As Integer, lastcol As Integer, counter2 As Integer, counter3 As Integer, GetBook As String, math1 As Double, math2 As Double, math3 As Double


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayAlerts = wdAlertsNone


GetBook = ActiveWorkbook.Name


lastrow = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
lastcol = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column


If Workbooks(GetBook).Worksheets(2).Cells(2, lastcol).Value = "CPI" Then
    Workbooks(GetBook).Worksheets(2).Columns(lastcol).Delete
    lastrow = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
    lastcol = Workbooks(GetBook).Worksheets(2).Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
End If


For counter2 = 1 To lastrow
    For counter3 = 1 To lastcol + 2
        Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3).NumberFormat = "?#,###,###,###.00;?#,###,###,###.00"
    Next counter3
Next counter2


For counter2 = 1 To lastcol + 1
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlDiagonalDown).LineStyle = xlNone
    Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlDiagonalUp).LineStyle = xlNone
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(2, counter2).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
Next counter2


For counter2 = 1 To lastrow
    For counter3 = 1 To lastcol + 2
            With Workbooks(GetBook).Worksheets(2).Cells(counter2, counter3)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
    Next counter3
Next counter2


Workbooks(GetBook).Worksheets(2).Cells(1, 1).ColumnWidth = 12
Workbooks(GetBook).Worksheets(2).Cells(1, 2).ColumnWidth = 12


For counter2 = 3 To lastcol + 1
    Workbooks(GetBook).Worksheets(2).Cells(1, counter2).ColumnWidth = 9
Next counter2


Workbooks(GetBook).Worksheets(2).Cells(2, lastcol + 1).Value = "CPI"
For counter2 = 5 To lastrow
    math1 = Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol).Value
    math2 = Workbooks(GetBook).Worksheets(2).Cells(counter2 - 1, lastcol).Value
    If math1 = 0 Or math2 = 0 Then
        math3 = 0
    Else
        math3 = math2 / math1
    End If
    Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 1).Value = math3
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 1).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol + 1).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2 - 2, lastcol).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = 2
    End With
    counter2 = counter2 + 2
Next counter2


For counter2 = 1 To lastrow
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, lastcol - 1).Borders(xlEdgeBottom)
        .LineStyle = xlNone
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, lastcol - 1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Workbooks(GetBook).Worksheets(2).Cells(counter2, lastcol - 1).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next counter2
    
Workbooks(GetBook).Worksheets(2).Cells(1, lastcol - 1).ColumnWidth = 2.29


Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.DisplayAlerts = wdAlertsAll


End Sub

Thank you for the help.
 
Last edited:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

A
  • Question
VBA run-time error
Replies
2
Views
275
Aaro23
A
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
333
RoryA
RoryA
F
  • Solved
VBA set conditional formatting application-defined or object-defined error
Replies
3
Views
78
Cubist
Cubist
C
  • Solved
Run-time error -2147417848 (80010108) automation error: the object invoked has disconnected from its clients
Replies
5
Views
243
NdNoviceHlp
NdNoviceHlp
D
  • Locked
  • Question
Range in worksheet1 Insert into worksheet2 from row 2
Replies
1
Views
162
Fluff
Fluff

Forum statistics

Threads
1,215,019
Messages
6,122,707
Members
449,093
Latest member
Mnur

Share this page

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