Ironman
Well-known Member
- Joined
- Jan 31, 2004
- Messages
- 1,069
- Office Version
- 365
- Platform
- Windows
Hi
Background:
I recently identified the below incomplete code as the long-time culprit of my workbook hanging for anything up to 5 minutes at a time when I save it and during that time it was using 45-50% of my PC's CPU.
I've now found the errors arose because I needed to add the below 2 rows of code for the other worksheet that was protected.
To cut to the chase, before I discovered the solution, the only way I was able to speed up the Save process was to have Outlook open at the same time, Save the workbook, (it then hangs) then switch to Outlook and start clicking one or two emails for a few seconds. Then lo and behind! Almost immediately the workbook completes the Save process as if by magic. This sounds crazy but I've done it so many times I'm certain it's no coincidence. Have I stumbled on a new solution here or is there a known reason why this method would work?
If anyone can provide an explanation, I'd very interested to know!
Many thanks!
Background:
I recently identified the below incomplete code as the long-time culprit of my workbook hanging for anything up to 5 minutes at a time when I save it and during that time it was using 45-50% of my PC's CPU.
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) ' copied from Open event 09.03.2019
With ThisWorkbook
Call UnprotectWorksheet(wks:=.Sheets("Training Log"))
Call ProtectWorksheet(wks:=.Sheets("Training Log"))
End With
Dim a
a = MsgBox("Are you SURE you want to overwrite the master Exercise Log file?", _
vbYesNo + vbExclamation, "WARNING")
If a = vbYes Then
Application.DisplayAlerts = False
Range("SaveDateTime") = _
"Last saved " & Format(Date, "ddd") & Format(Time, " HH:MM") & ","
Application.DisplayAlerts = True
With ThisWorkbook
Application.EnableEvents = False
.Save
Application.EnableEvents = True
'FileSize = FileLen(ActiveWorkbook.FullName) / 1000000 & " Mb"
Sheets("Training Log").Range("B1") = "file size = " & Round(FileLen(ActiveWorkbook.FullName) / 1000000, 1) & "Mb"
'If you want to show file size in Kb, replace with the following code:
'Sheets("Training Log").Range("B1") = "file size = " & Round(FileLen(.FullName) / 1024, 0) & "kb"
End With
Else
Cancel = True
MsgBox "Existing file unchanged ", vbInformation, "Exercise Log"
End If
End Sub
I've now found the errors arose because I needed to add the below 2 rows of code for the other worksheet that was protected.
Code:
Call UnprotectWorksheet(wks:=.Sheets("Daily Tracking"))
Call ProtectWorksheet(wks:=.Sheets("Daily Tracking"))
If anyone can provide an explanation, I'd very interested to know!
Many thanks!
Last edited: