Ironman
Well-known Member
- Joined
- Jan 31, 2004
- Messages
- 1,069
- Office Version
- 365
- Platform
- Windows
Hi
This is my workbook_before close event code.
I'd be grateful to know if the 20 seconds or so it takes to close can be expected with the below code or if there's something obvious that can be amended to speed it up?
Many thanks!
This is my workbook_before close event code.
I'd be grateful to know if the 20 seconds or so it takes to close can be expected with the below code or if there's something obvious that can be amended to speed it up?
Many thanks!
VBA Code:
Private Sub workbook_beforeclose(Cancel As Boolean)
Dim MsgResult As Integer
Application.EnableEvents = False
MsgResult = MsgBox("Are you SURE you want to overwrite the master Exercise Log file? ", vbYesNoCancel + vbExclamation, "WARNING")
Select Case MsgResult
Case vbNo
'a) If you select No, you get a second dialog box saying "Existing file unchanged" and the workbook as well as Excel will close.
'checks to see if other workbooks are open. It will not shut down the application if there are other workbooks open
If Application.Workbooks.Count < 2 Then
MsgBox "Master file unchanged - data NOT saved" & vbNewLine _
& "" & vbNewLine _
& "Exercise Log will now close", vbInformation, "Master File Unchanged "
'the following line does not save the workbook but sets a bit that tells Excel that any changes have already been saved, even if the changes were not actually saved
ThisWorkbook.Saved = True
Application.Quit
Else
'other workbooks are open. Leave the application alone and
'simply close this workbook.
MsgBox "Other workbooks open - data NOT saved!" & vbNewLine _
& "" & vbNewLine _
& "Exercise Log will now close!", vbInformation, "Master File Unchanged "
Me.Close False
End If
Case vbCancel
'b) If I select Cancel then there's no action, the dialog box closes and the workbook remains open as if nothing had happened.
Cancel = True
'simply cancel the closing of this workbook
Case vbYes
'c) If I select Yes, then the new data is saved, a second dialog box appears + vbconf with existing data overwritten.
' The file and Excel then close.
'Bernie Dietrick
Dim bdFileName As String
Dim FullFileName As String
Application.DisplayAlerts = False
FullFileName = ActiveWorkbook.FullName
bdFileName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)
If LCase(Application.UserName) <> "jsullivan" Then
ActiveWorkbook.SaveCopyAs Filename:="E:\BACKUPS\Exercise Log\" & _
bdFileName & " Backup - " & Format(Now, "dddd dd mmmm yyyy, h.mmam/pm") & _
".xlsm"
'Backup to 128gb USB drive as well
ActiveWorkbook.SaveCopyAs Filename:="Y:\DOCUMENTS\EXERCISE LOG\Exit Backups\" & _
bdFileName & " Backup - " & Format(Now, "dddd dd mmmm yyyy, h.mmam/pm") & _
".xlsm"
End If
ActiveWorkbook.SaveAs Filename:=FullFileName, AddToMru:=False
Application.DisplayAlerts = True
Worksheets("Training Log").[H1:H9] = vbNullString
'Worksheets("Analysis").[G1:Z1] = vbNullString
'Worksheets("Iron Man Log").[G1:Z1] = vbNullString
Worksheets("Daily Tracking").[CI1:CZ1] = vbNullString
Worksheets("Indoor Bike").[I1:I2] = vbNullString
'Application.EnableEvents = True 'commented out 20.09.2021
MsgBox "New backup files created in" & vbNewLine & vbNewLine _
& "E:\BACKUPS\EXERCISE LOG " & vbNewLine & vbNewLine _
& "Y:\DOCUMENTS\EXERCISE LOG\EXIT BACKUPS" & vbNewLine & vbNewLine _
& "Exercise Log will now close", vbInformation, "Master File Overwritten"
ThisWorkbook.Saved = True
'Application.EnableEvents = True
End Select
Application.EnableEvents = True
End Sub
)
