CODEWITHSUNDEEP
excelvba
Matt Ridge
Matt Ridge

Reputation: 3651

How to automatically Save and Exit out of a worksheet after a set amount of time? (Excel VBA)

Is there a way to make an open worksheet close itself if there is no activity on it for more than 5 minutes?

So for example: I work on a worksheet for a while then walk away for 20 minutes with said sheet open. Someone on the network requires to access the sheet but can't because I'm on it.

I want it so that after me being away from my desk for more than 5 minutes the sheet will save itself and close out said sheet.

Is this possible? If so how? I can find scripts to show how to save and close a sheet, but I've yet to find one that uses a timer...

Upvotes: 2

Views: 10636

Answers (2)

Matt Ridge
Matt Ridge

Reputation: 3651

Ok, with the original answer below, I came up with my own, after a little more research.

Once you open the developer's section you will find your sheets, place this code below into ThisWorkbook. That will allow your code to work through the entire sheet. I now it set up where there is a 10:00 minute initial timer, and a 05:00 minute timer if there is activity after the fact. You can change that to whatever you want.

Option Explicit
Private Sub Workbook_Open()
    EndTime = Now + TimeValue("00:10:00")
    RunTime
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If EndTime Then
        Application.OnTime _
                EarliestTime:=EndTime, _
                Procedure:="CloseWB", _
                Schedule:=False
        EndTime = Empty
    End If
    EndTime = Now + TimeValue("00:05:00")
    RunTime
End Sub

The part below this needs to go into a newly created module, name it whatever you want, mine is called SaveWB

Option Explicit

Public EndTime
Sub RunTime()
    Application.OnTime _
            EarliestTime:=EndTime, _
            Procedure:="CloseWB", _
            Schedule:=True
End Sub

Sub CloseWB()
    Application.DisplayAlerts = False
    With ThisWorkbook
        ThisWorkbook.Close savechanges:=True
    End With
End Sub

I changed the code from:

With ThisWorkbook
    .Save
    .Saved = True
    .Close
End With

To what was above it.

    With ThisWorkbook
        ThisWorkbook.Close savechanges:=True
    End With

The part I created works, the part that was originally posted works in closing but not saving. Do what you will with it, change it as you deem fit, but I am glad I got it working.

Upvotes: 2

Alistair Weir
Alistair Weir

Reputation: 1849

This is the information from the link so this question can be used as a reference:

Insert this code as module:

' DateTime  : 09/05/2007 08:43
' Author    : Roy Cox (royUK)
' Website   :  Clck here for more examples and Excel Consulting
' Purpose   : Place in a standard module
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

'---------------------------------------------------------------------------------------
Option Explicit
Public EndTime
Sub RunTime()
    Application.OnTime _
            EarliestTime:=EndTime, _
            Procedure:="CloseWB", _
            Schedule:=True
End Sub
Sub CloseWB()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Save
        .Saved = True
        .Close
    End With
End Sub

Insert this in 'ThisWorkbook'

Private Sub Workbook_Open()
    '--> Set Time Below
    EndTime = Now + TimeValue("00:00:00")
    RunTime
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If EndTime Then
        Application.OnTime _
        EarliestTime:=EndTime, _
        Procedure:="CloseWB", _
        Schedule:=False
        EndTime = Empty
    End If
    '--> Set Time Below
    EndTime = Now + TimeValue("00:00:00")
    RunTime
End Sub

Upvotes: 3

Related Questions