Does anyone know any VBA code that will close and save an excel file after a delay? I tried some kutools
code that was supposed to close only after some idle time but it closes without checking for inactivity.
Asked
Active
Viewed 3,495 times
0

F_SO_K
- 13,640
- 5
- 54
- 83

Pedro Gaspar
- 9
- 1
- 8
-
3Using `Application.OnTime` you can schedule a Macro to close the Workbook, See [Chip Pearson's - OnTime](http://www.cpearson.com/excel/ontime.aspx) – May 21 '18 at 06:55
-
In addition to using `OnTime`, You should be clearing the previous `OnTime` events to get only the last event to be active. You may want to check this link for some useful ideas: [link](https://stackoverflow.com/questions/4599796/how-can-i-check-for-or-cancel-multiple-pending-application-ontime-events-in-exce) – Hakan ERDOGAN May 21 '18 at 09:52
2 Answers
0
Paste in Routine Module:
Option Explicit
Const idleTime = 30 'seconds
Dim Start
Sub StartTimer()
Start = Timer
Do While Timer < Start + idleTime
DoEvents
Loop
'///////////////////////////////////////////////////////
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Step 1: Declare your variables
Dim ws As Worksheet
'Step 2: Unhide the Starting Sheet
Sheets("Sheet1").Visible = xlSheetVisible
'Step 3: Start looping through all worksheets
For Each ws In ThisWorkbook.Worksheets
'Step 4: Check each worksheet name
If ws.Name <> "Sheet1" Then
'Step 5: Hide the sheet
ws.Visible = xlVeryHidden
End If
'Step 6: Loop to next worksheet
Next ws
'Application.ScreenUpdating = True
Range("A1").Select
ThisWorkbook.Save
'Application.DisplayAlerts = True
'//////////////////////////////////////////////////////////
'Application.DisplayAlerts = False
Application.Quit
ActiveWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub
Paste in ThisWorkbook :
Option Explicit
Private Sub Workbook_Open()
StartTimer
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
StartTimer
End Sub

Jerry
- 100
- 2
- 9
-
The time only resets when changing sheet? Because it iwll be a userform to input data. – Pedro Gaspar May 22 '18 at 07:07
0
Paste in Routine Module:
Sub Reset()
Static SchedSave
If SchedSave <> 0 Then
Application.OnTime SchedSave, "SaveWork", , False
End If
SchedSave = Now + TimeValue("00:10:00") '<--- Ten minutes
Application.OnTime SchedSave, "SaveWork", , True
End Sub
Sub SaveWork()
MsgBox "Run the close workbook macro here."
'ThisWorkbook.Save
'Application.Quit
'ThisWorkbook.Close
End Sub
Paste in ThisWorkbook:
Private Sub Workbook_Open()
Reset
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Reset
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Reset
End Sub
Timer will start automatically when workbook is opened. Presently set for 10 minutes (can be adjusted). Closing macro code has been disabled and presently replaced with a MsgBox notice.

Jerry
- 100
- 2
- 9