VBA to autosave and close after a set amount of time

[ceranes]

We have the same problem at work as I'm sure many others have had. Someone opens the shared spreadsheet file, then jumps on a conference call, leaves the office, and forgot they left it open. Several hours pass and nobody is able to do any work in the file.

I asked our girl in IT about this, she gave me some VBA, but she is not really versed in it. She claims it works on her computer, but I am unable to get it to work on mine. I am using Excel 365. Others in our office either use that version or a version much older, such as Excel 2016 or even 2013.

This is really a two-part question.

First I copied a test version onto my desktop and saved it as a macro-enabled file (.xlsm).

Next, I followed her instructions to a tee.

First, I opened the workbook and then the Visual Basic Editor by clicking the Developer tab and then Visual Basic. Next I click the Insert tab and selected Module. I entered the following code.

Dim TheTime As Long

Sub StartTimer()

TheTime = Timer
Application.OnTime Now + TimeValue("00:10:00"), "CloseSave"

End Sub

Sub CloseSave()

If Timer - TheTime > 580 Then

ThisWorkbook.Close SaveChanges:=True

End If

End Sub

Next I double-clicked on ThisWorkbook, and entered the following code.

style='font-family:inherit;color:#141414'>Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 
StartTimer
 
End Sub

According to the lady I spoke with, after 10 minutes of inactivity, it would automatically save and close the file. I modified the time for a single minute (60 seconds), and it just sat there.

Does anybody see anything wrong with the VBA?

The second part of this issue is how do you force Excel to automatically run the VBA content without having to prompt someone to accept it? If we can't get someone to remember to save and close a file when they're finished, they're sure as not going to click a button to accept a macro. They'll just click off it.

Thanks for your time!

Chris

 

[Logit]

.

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

Download workbook : Auto Close After N min of Inactivity.xlsm



Here is a simpler version :

Option Explicit

Const idleTime = 60 'seconds If NO activity of any kind occurs within 60 seconds, WB closes and auto saves.
Dim Start
Sub StartTimer()
    Start = Timer
    Do While Timer < Start + idleTime
        DoEvents
    Loop
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
      
    
    Application.Quit
    ActiveWorkbook.Close SaveChanges:=True
    
    Application.DisplayAlerts = True
End Sub

 

[Mustafa Evans]

I really like this idea of auto closing and saving after a certain amount of time. I'm having issues with a shared spreadsheet with users often leaving them open for hours at a time. What I don't understand however is what code do I put where. And was the issue of making the user click enable macro resolved.

Would really appreciate your help with this.

 

[Logit]

The end user must have MACROS ENABLED on their copy of EXCEL.

To make the "time out" macro auto-enabled, place a "call" to the macro in the ThisWorkbook module Workbook_Open macro.

For example :

Option Explicit

Private Sub Workbook_Open()

     StartTimer

End Sub

Then, the actual macro StartTimer needs to be pasted into a Regular module :

Option Explicit

Const idleTime = 60 'seconds If NO activity of any kind occurs within 60 seconds, WB closes and auto saves.

Dim Start

Sub StartTimer()

    Start = Timer

    Do While Timer < Start + idleTime

        DoEvents

    Loop

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Application.Quit

    ActiveWorkbook.Close SaveChanges:=True

    Application.DisplayAlerts = True

End Sub

This allows the macro to auto-run each time the workbook is open - doesn't need the end user to activate the macro and .... for most end users, they won't even
know the macro is there or running.

 

[Logit]

How to force End Users to enable macros :

Forcing Your Clients to Enable Excel Macros - dummies

 

[deanop2]

The end user must have MACROS ENABLED on their copy of EXCEL.

To make the "time out" macro auto-enabled, place a "call" to the macro in the ThisWorkbook module Workbook_Open macro.

For example :

Option Explicit

Private Sub Workbook_Open()

     StartTimer

End Sub

Then, the actual macro StartTimer needs to be pasted into a Regular module :

Option Explicit

Const idleTime = 60 'seconds If NO activity of any kind occurs within 60 seconds, WB closes and auto saves.

Dim Start

Sub StartTimer()

    Start = Timer

    Do While Timer < Start + idleTime

        DoEvents

    Loop

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Application.Quit

    ActiveWorkbook.Close SaveChanges:=True

    Application.DisplayAlerts = True

End Sub

This allows the macro to auto-run each time the workbook is open - doesn't need the end user to activate the macro and .... for most end users, they won't even
know the macro is there or running.

I use this a lot thanks. Came across an issue. I have a sheet that's read only except for a chosen few. When the other viewing the sheet in read only leave it open it prompts to save as, how do I stop that? Thanks

 

[lojanica]

Try this:
Replace this:

Whit this

Option Explicit

Dim CloseTime As Date
Sub TimeSetting()
    CloseTime = Now + TimeValue("00:10:00")
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
    On Error Resume Next
    Application.OnTime EarliestTime:=CloseTime, _
      Procedure:="SavedAndClose", Schedule:=False
 End Sub
Sub SavedAndClose()
    Application.DisplayAlerts = False
    ActiveWorkbook.Close Savechanges:=True
    Application.DisplayAlerts = True
End Sub

And this:

Whit this:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call TimeStop
End Sub
 
Private Sub Workbook_Open()
    Call TimeSetting
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   Call TimeStop
   Call TimeSetting
End Sub

I believe I have finally got this to work. It does not close in the middle of typing things, and the timer works as expected. I guess the only other thing I would it to do is close the Excel program window, not just the sheet the person is currently working in.

Here is the code for the Module1.

Dim DownTime As Date

Sub SetTimer()
    DownTime = Now + TimeValue("00:01:00")
    Application.OnTime EarliestTime:=DownTime, _
    Procedure:="ShutDown", Schedule:=True
End Sub
Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=DownTime, _
      Procedure:="ShutDown", Schedule:=False
 End Sub
Sub ShutDown()
    Application.DisplayAlerts = False
    ThisWorkbook.Close SaveChanges:=True
End Sub

Here is the code under ThisWorkbook:

Private Sub Workbook_Open()
    Call SetTimer
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer
End Sub

Hi
I know it has been a while since you posted this, but hopefully, you can answer my questions.
Your code works perfectly on the new document. However, I would like to implement it in the document, which already has code under ThisWorkbook.
Please see the below code under ThisWorkbook in my document.

Private Sub Workbook_Open()

ThisWorkbook.Sheets("AMSI-R-102 Job Request Register").Range("B6").Value = Environ("USERNAME")

 Call SetTimer

    Dim mainwb As Workbook
    Dim usernameSheetName As String
    Dim targetSheet As Worksheet
    
    Set mainwb = ActiveWorkbook
    usernameSheetName = mainwb.Sheets("AMSI-R-102 Job Request Register").Range("B6").Value
        
    On Error Resume Next
    Set targetSheet = mainwb.Sheets(usernameSheetName)
    On Error GoTo 0
    
    If Not targetSheet Is Nothing Then
        targetSheet.Activate
    Else
        mainwb.Sheets("AMSI-R-102 Job Request Register").Activate
        Exit Sub
    End If

    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If

    Range("A6:I6").AutoFilter Field:=8, Criteria1:=Range("B6")
    Range("A6:I6").AutoFilter Field:=7, Criteria1:="In progress"
    
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Range("A8:I" & lastRow).Sort Key1:=Range("D8:D" & lastRow), Order1:=xlAscending, Header:=xlNo

End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Call StopTimer
    Call SetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
    Call StopTimer
    Call SetTimer
End Sub

As you can see, I have moved "Call SetTimer" to the existing Private Sub Workbook_Open().
The problem is that when the timer is up, the document closes and opens again with a message from the attached photo.
If I press Enable Macro, it goes in a loop, opening and closing the document.
If I press disable Macro, an error message appears. When I press okay, it pops up again and again.

My existing code is affecting it, but I cannot see what is causing these issues.
Any Suggestions?