All Open Excel Workbooks Close on Completion of Macro

[AlexB123]

Hi all,

I have some VBA that takes raw output and adds columns to format the final file for upload to another database. At the end the macro shuts down all open instances of Excel. I tried to comment out the last few lines before my error handler (i.e., Application.Quit and AcvtiveWorkbook.Close).

Thanks.

Private Sub CreateTPS()
On Error GoTo ErrHndl
'Add Updating/Efficiency Properties
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
Dim archiveFolder As String: archiveFolder = "C:\Users\Alex"
Dim yearFolder, monthFolder, dataFile, workingFileShort, fLinkShort, fErrorsShort As String
Dim fTemplate, fTemplateShort, fTPSExport, fTPSShort, fMacro, fNew As String
Dim pathYear As String: pathYear = archiveFolder & Year(Now())
Dim pathFull As String: pathFull = pathYear & "\" & MonthName(Month(Now))
Dim qtyChecks As Integer
Dim amtChecks As Double
Dim i As Integer: i = 0 'for loops
fTemplate = "C:\Users\Alex\TPS File Upload Format.xlsx"
fTPSExport = "C:\Users\Alex\ExportTPS.xlsx"
fMacro = ActiveWorkbook.Name
'create archive folders
If Len(Dir(pathYear, vbDirectory)) = 0 Then
    MkDir (pathYear)
    End If
If Len(Dir(pathFull, vbDirectory)) = 0 Then
    MkDir (pathFull)
    End If
Workbooks.Open (fTPSExport)
fTPSShort = ActiveWorkbook.Name
lastrow = Rows.Range("a65536").End(xlUp).Row
qtyChecks = lastrow - 1
Range("R1").Formula = "=SUM(R2:R" & lastrow & ")"                   ' "Amount" Column
amtChecks = Range("R1").Value
'PayType Column
Range("D2").Formula = "=IF(AND(B2=B3,B2<>B1),""XL"",IF(AND(OR(B2=B3,B2=B1),D1=""XL""),""XM"",IF(AND(OR(B2=B3,B2=B1),D1=""XM""),""XN"",IF(AND(OR(B2=B3,B2=B1),D1=""XN""),""XO"",""XL""))))"
Range("D2").Copy
Range("D3:D" & lastrow).PasteSpecial
Range("D:D").Copy
Range("D:D").PasteSpecial xlPasteValues
'remove sci-notation and headers
Columns("U:U").NumberFormat = "0"
Rows("1:1").Delete Shift:=xlUp
    
'add columns
Columns("G:G").Insert                                               'Middle Name - Shifts "LastName" over one col to H
Columns("I:I").Insert                                               'Suffix - Shifts "Expr5" over one col to J
Columns("K:K").Insert                                               'Payee Name Line 2 = Shifts "Address1" over one col to L
i = 0: Do Until i = 13: Columns("S:S").Insert: i = i + 1: Loop      '13 - Adds 13 columns, loop stops after i=12. Memo1 becomes column AF, Memo2 becomes AG
i = 0: Do Until i = 18: Columns("AI:AI").Insert: i = i + 1: Loop    '18 - Adds 18 columns, loop stops after i=17. Expr2 will become column BA; make room for new "NRA Foreign Tax Identifying Number"
Columns("BA:BA").Insert                                             ' Inserts one column, Expr10 becomes column BB
i = 0: Do Until i = 11: Columns("BC:BC").Insert: i = i + 1: Loop    '11 - Adds 11 columns, loop stops after i=10. Expr6 becomes column BO.
i = 0: Do Until i = 8: Columns("BP:BP").Insert: i = i + 1: Loop     '8 - Adds 8 columns, loop stops after i=7. Expr7 becomes column BY.
i = 0: Do Until i = 13: Columns("BZ:BZ").Insert: i = i + 1: Loop    '13 for special handling/overnight. OvrNt becomes column CN.
'Copy data
Range("A1:CN" & lastrow).Copy
Workbooks.Open (fTemplate)
fTemplateShort = ActiveWorkbook.Name
Range("A4").PasteSpecial
Range("A1").Select

'lock file and save file
ActiveSheet.Protect Password:="tps200"
ActiveWorkbook.SaveAs "C:\Users\Alex\TPSUpload.xlsx"
ActiveWorkbook.SaveAs pathFull & "\" & Format(CDate(Now()), "YYYY-MM-DD HH.NN.SS") & " TPS.xlsx"
'Reenable Update/Optimization settings
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
    End With
'Close Workbook
Workbooks(fTPSShort).Activate
ActiveWorkbook.Close False
Application.Quit
Exit Sub
ErrHndl:
    MsgBox "An error has occurred.  Please see an administrator."
    Application.DisplayAlerts = True
    Application.Quit
End Sub

 

[Joe4]

So what exactly is your question?

 

[AlexB123]

Is there something in the code making all the workbooks close? Or is it possible all the loops are making Excel crash?

Thanks

 

[Joe4]

Yes. Application.Quit will close EVERYTHING in Excel. It closes the entire Excel application.
Note that you have that command in TWO places:

[COLOR=#ff0000]Application.Quit[/COLOR]
Exit Sub
ErrHndl:
    MsgBox "An error has occurred.  Please see an administrator."
    Application.DisplayAlerts = True
    [COLOR=#ff0000]Application.Quit[/COLOR]
End Sub

If you want to just close specific workbooks, use the Workbook(workbook_name).Close methodology.

If you are not sure why certain sections of your code are being hit, then use F8 and step through your code line-by-line so you can see exactly which lines of your code are being called. If it is hitting error handling, it should be easy to then see exactly what is causing that.

 

[AlexB123]

Thanks!

 

[Joe4]

You are welcome.