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

 

[afonsomira]

Try this:
Replace this:

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

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:

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

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

 

[Yongle]

deleted by Yongle

 

[Yongle]

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.

To force someone to accept a macro ...

ONE WAY - make it so that the key sheets cannot be seen unless they are made visible with VBA

VeryHidden sheets can only be made visible with VBA

ws.Visible = xlSheetVeryHidden

1 Add a new "landing" sheet
2 Use Workbook_Open to make key sheets visible and to hide the "landing" sheet
3 Use Workbook_BeforeSave to make "landing" sheet visble and to hide key sheets( as VeryHidden)

For assistance, refer to this post AFTER you have resolved the title issue and ask for the help you require

 

[ceranes]

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

This definitely works! However, while I was in the middle of entering formulas in the Excel document, it went ahead and saved and closed on me. How can we modify it so it only saves and closes after a certain amount of inactivity? Either I get up and walk away or I am working in another program, and forget the Excel document was left open?

 

[Yongle]

This definitely works! However, while I was in the middle of entering formulas in the Excel document, it went ahead and saved and closed on me. How can we modify it so it only saves and closes after a certain amount of inactivity? Either I get up and walk away or I am working in another program, and forget the Excel document was left open?

Try inserting this macro in ThisWorbook code window (it will NOT work if placed in a module like Module1)

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     CloseTime = Now + TimeValue("00:10:00")
End Sub

 

[ceranes]

Try inserting this macro in ThisWorbook code window (it will NOT work if placed in a module like Module1)

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
     CloseTime = Now + TimeValue("00:10:00")
End Sub

Are you recommending, I replace the three sub-routines already in the ThisWorkbook window with your sub-routine, or just add it to the bottom?

 

[Yongle]

Please ignore my suggestion

 

[ceranes]

Do you have any other suggestions on how to keep this from auto saving and closing while I'm in the middle of entering items?

 

[ceranes]

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