Countdown timer
 

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.

Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia

Jock


"JLatham" wrote:

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.

"Jock" wrote:

JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.

Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia

Jock


"JLatham" wrote:

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

All help is very much appreciated.
--
tia

Jock


"JLatham" wrote:

Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.

"Jock" wrote:

JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.

Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia

Jock


"JLatham" wrote:

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Jock, I believe this will do it for you.

Just replace your existing code in the Workbook code module with the code
below. Notice that one Const is declared outside of the Sub codes. That is
so it can be declared once and and then referenced by any/all Sub/Functions
in that code module. It's referenced in two routines now. That is the
definition of the cell where you want the time remaining to be displayed on
the worksheet(s). I've got it set to $C$1 now, just change it to the correct
cell address for your use. The countdown is set to 2hrs 1 min just like your
event is set for.

I created Const values for everything you might need to change and placed
them into the declarations section so that you can change them one time in
the code and any place else in the code that needs them will automatically be
updated with the new values, that includes a new definition for the
"02:01:00" you use in setting up the workbook save/close timed task.

When you change that $C$1 entry, be certain to use absolute addressing (the
$ signs) before the column identifier and row number in the address. The
code tests to see if a worksheet change took place in that cell and it uses
that form of addressing. We have to ignore changes to worksheet in that cell
because if we don't then the Workbook_SheetChange() event would reset that
countdown to the beginning every second. The test prevents that from
happening.

As is noted in the code, once this gets going, which it's going to do either
when you open the workbook or when you make a change on any worksheet, then
it runs forever. So if you have to go into the code module to make changes,
it will still be running. In order to make any code changes, you'll have to
stop the process - once you get into the VB Editor, either just click the
[Reset] icon (small square as on a VCR/CD/DVD player to STOP play) or use Run
| Reset from the VB menu toolbar.

If you have any questions or need more assistance, either post here, or if
it is of nature that the information/question won't really serve to assist
others here, you can email me at [remove spaces] HelpFrom @ JLathamsite.com
If you need, I can even make a working copy of my file here available to you
for download from my site.

The new code - just cut and paste over the existing code for these two
workbook events:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$C$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
Const TimeAllowed = 7260 '7260 = 2hrs 1min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "02:01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub


"Jock" wrote:

All help is very much appreciated.
--
tia

Jock


"JLatham" wrote:

Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.

"Jock" wrote:

JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.

Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia

Jock


"JLatham" wrote:

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

J.
That is fantastic. Thank you very much for yourtime and effort in helping me
with this. You obviously enjoy a challenge.
One final thing. I have tweaked it slightly, moved the display cell to $I$1
and removed the hours part (as I intend to limit the workbook to 20 mins
inactivity before shutdown) but, if poss, I would like the words 'before
automatic save & close' to appear in I1 after the timer display (it's a very
wide cell).

Thanks in advance


Jock


"JLatham" wrote:

Jock, I believe this will do it for you.

Just replace your existing code in the Workbook code module with the code
below. Notice that one Const is declared outside of the Sub codes. That is
so it can be declared once and and then referenced by any/all Sub/Functions
in that code module. It's referenced in two routines now. That is the
definition of the cell where you want the time remaining to be displayed on
the worksheet(s). I've got it set to $C$1 now, just change it to the correct
cell address for your use. The countdown is set to 2hrs 1 min just like your
event is set for.

I created Const values for everything you might need to change and placed
them into the declarations section so that you can change them one time in
the code and any place else in the code that needs them will automatically be
updated with the new values, that includes a new definition for the
"02:01:00" you use in setting up the workbook save/close timed task.

When you change that $C$1 entry, be certain to use absolute addressing (the
$ signs) before the column identifier and row number in the address. The
code tests to see if a worksheet change took place in that cell and it uses
that form of addressing. We have to ignore changes to worksheet in that cell
because if we don't then the Workbook_SheetChange() event would reset that
countdown to the beginning every second. The test prevents that from
happening.

As is noted in the code, once this gets going, which it's going to do either
when you open the workbook or when you make a change on any worksheet, then
it runs forever. So if you have to go into the code module to make changes,
it will still be running. In order to make any code changes, you'll have to
stop the process - once you get into the VB Editor, either just click the
[Reset] icon (small square as on a VCR/CD/DVD player to STOP play) or use Run
| Reset from the VB menu toolbar.

If you have any questions or need more assistance, either post here, or if
it is of nature that the information/question won't really serve to assist
others here, you can email me at [remove spaces] HelpFrom @ JLathamsite.com
If you need, I can even make a working copy of my file here available to you
for download from my site.

The new code - just cut and paste over the existing code for these two
workbook events:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$C$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
Const TimeAllowed = 7260 '7260 = 2hrs 1min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "02:01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub


"Jock" wrote:

All help is very much appreciated.
--
tia

Jock


"JLatham" wrote:

Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.

"Jock" wrote:

JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.

Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia

Jock


"JLatham" wrote:

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Hi again,
Slight problem that when the counter reaches 1 sec, it stops there and
doesn't shut down the workbook. I have changed it to one minute just for
evaluation purposes. Could it be the changes I've made? (see code below). If
I input something in a worksheet though, the timer starts again.
Help!!
lol
--
tia

Jock


"Jock" wrote:

J.
That is fantastic. Thank you very much for yourtime and effort in helping me
with this. You obviously enjoy a challenge.
One final thing. I have tweaked it slightly, moved the display cell to $I$1
and removed the hours part (as I intend to limit the workbook to 20 mins
inactivity before shutdown) but, if poss, I would like the words 'before
automatic save & close' to appear in I1 after the timer display (it's a very
wide cell).

Thanks in advance


Jock


"JLatham" wrote:

Jock, I believe this will do it for you.

Just replace your existing code in the Workbook code module with the code
below. Notice that one Const is declared outside of the Sub codes. That is
so it can be declared once and and then referenced by any/all Sub/Functions
in that code module. It's referenced in two routines now. That is the
definition of the cell where you want the time remaining to be displayed on
the worksheet(s). I've got it set to $C$1 now, just change it to the correct
cell address for your use. The countdown is set to 2hrs 1 min just like your
event is set for.

I created Const values for everything you might need to change and placed
them into the declarations section so that you can change them one time in
the code and any place else in the code that needs them will automatically be
updated with the new values, that includes a new definition for the
"02:01:00" you use in setting up the workbook save/close timed task.

When you change that $C$1 entry, be certain to use absolute addressing (the
$ signs) before the column identifier and row number in the address. The
code tests to see if a worksheet change took place in that cell and it uses
that form of addressing. We have to ignore changes to worksheet in that cell
because if we don't then the Workbook_SheetChange() event would reset that
countdown to the beginning every second. The test prevents that from
happening.

As is noted in the code, once this gets going, which it's going to do either
when you open the workbook or when you make a change on any worksheet, then
it runs forever. So if you have to go into the code module to make changes,
it will still be running. In order to make any code changes, you'll have to
stop the process - once you get into the VB Editor, either just click the
[Reset] icon (small square as on a VCR/CD/DVD player to STOP play) or use Run
| Reset from the VB menu toolbar.

If you have any questions or need more assistance, either post here, or if
it is of nature that the information/question won't really serve to assist
others here, you can email me at [remove spaces] HelpFrom @ JLathamsite.com
If you need, I can even make a working copy of my file here available to you
for download from my site.

The new code - just cut and paste over the existing code for these two
workbook events:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$C$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
Const TimeAllowed = 7260 '7260 = 2hrs 1min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "02:01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub


"Jock" wrote:

All help is very much appreciated.
--
tia

Jock


"JLatham" wrote:

Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.

"Jock" wrote:

JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.

Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia

Jock


"JLatham" wrote:

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Don't blame yourself just yet - may be that my added code and fact that it's
in a kind of perpetual loop is killing your auto-save-shutdown process. I
didn't let the timer go down to zero (should have, my bad) to test that
aspect of it. Easy enough to fix, if it is tying things up. I'll look at it
today.

As for the change to display - look for where I build up the string to stick
into the cell and simply add
& " before automatic save and close"
to the line of code. Need a space before and after the & symbol in it.

"Jock" wrote:

Hi again,
Slight problem that when the counter reaches 1 sec, it stops there and
doesn't shut down the workbook. I have changed it to one minute just for
evaluation purposes. Could it be the changes I've made? (see code below). If
I input something in a worksheet though, the timer starts again.
Help!!
lol
--
tia

Jock


"Jock" wrote:

J.
That is fantastic. Thank you very much for yourtime and effort in helping me
with this. You obviously enjoy a challenge.
One final thing. I have tweaked it slightly, moved the display cell to $I$1
and removed the hours part (as I intend to limit the workbook to 20 mins
inactivity before shutdown) but, if poss, I would like the words 'before
automatic save & close' to appear in I1 after the timer display (it's a very
wide cell).

Thanks in advance


Jock


"JLatham" wrote:

Jock, I believe this will do it for you.

Just replace your existing code in the Workbook code module with the code
below. Notice that one Const is declared outside of the Sub codes. That is
so it can be declared once and and then referenced by any/all Sub/Functions
in that code module. It's referenced in two routines now. That is the
definition of the cell where you want the time remaining to be displayed on
the worksheet(s). I've got it set to $C$1 now, just change it to the correct
cell address for your use. The countdown is set to 2hrs 1 min just like your
event is set for.

I created Const values for everything you might need to change and placed
them into the declarations section so that you can change them one time in
the code and any place else in the code that needs them will automatically be
updated with the new values, that includes a new definition for the
"02:01:00" you use in setting up the workbook save/close timed task.

When you change that $C$1 entry, be certain to use absolute addressing (the
$ signs) before the column identifier and row number in the address. The
code tests to see if a worksheet change took place in that cell and it uses
that form of addressing. We have to ignore changes to worksheet in that cell
because if we don't then the Workbook_SheetChange() event would reset that
countdown to the beginning every second. The test prevents that from
happening.

As is noted in the code, once this gets going, which it's going to do either
when you open the workbook or when you make a change on any worksheet, then
it runs forever. So if you have to go into the code module to make changes,
it will still be running. In order to make any code changes, you'll have to
stop the process - once you get into the VB Editor, either just click the
[Reset] icon (small square as on a VCR/CD/DVD player to STOP play) or use Run
| Reset from the VB menu toolbar.

If you have any questions or need more assistance, either post here, or if
it is of nature that the information/question won't really serve to assist
others here, you can email me at [remove spaces] HelpFrom @ JLathamsite.com
If you need, I can even make a working copy of my file here available to you
for download from my site.

The new code - just cut and paste over the existing code for these two
workbook events:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$C$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
Const TimeAllowed = 7260 '7260 = 2hrs 1min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "02:01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub


"Jock" wrote:

All help is very much appreciated.
--
tia

Jock


"JLatham" wrote:

Let me examine/test things a little and I'll get back with you. I want to
make sure that what I do fits in with what you have already in place.

"Jock" wrote:

JL, not sure how to aproach this as I would like the 'timer' to appear on the
open workbook and be linked to the code checking for inactivity (below). I'm
not that well up on codes and how to modify them to achieve the desired
results. Any help appreciated.

Private Sub Workbook_Open()
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.OnTime RunTime, "SaveAndCloseMe", , False
RunTime = Now() + TimeValue("02:01:00")
Application.OnTime RunTime, "SaveAndCloseMe"
End Sub

This saves and closes the workbook after 2 hrs and 1 minute of inactivity.
--
tia

Jock


"JLatham" wrote:

Jock, I wrote it as a 'stand-alone' Sub so that I could test it, but I
actually envision it as being part of the routine you're using now that
closes the book due to inactivity. Or you can put it into your book as is,
and just call it from within another routine, such as the one you have
checking for inactivity already.

"Jock" wrote:

Thanks, I'll give it a try
--
tia

Jock


"JLatham" wrote:

Yes, You can probably incorporate this into the routine you have set up to
check for inactivity. Here's routine that puts 60 seconds on the clock, and
then displays time remaining in C1 of the active sheet.

Sub DisplayTimeRemaining()
'displays time remaining in seconds
Const TimeAllowed = 60 ' 60 second countdown
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
Range("C1") = TimeRemaining
TimePassed = Timer
End If
DoEvents
Loop
Range("C1") = 0
End Sub


"Jock" wrote:

I have used vba code to automatically save then close an pen workbook which
has had no activity for a specified period of time. Is it at all possible to
have a countdown clock displayed is a cell in the workbook indicating to the
user how long is left before shut down?
--
tia

Jock

Countdown timer
 

Sorry, I forgot to paste the altered code on my last reply; here it is:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'20 minutes
'calculated as (60*20) = 1200
Const TimeAllowed = 60 '60 = 1 min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

'TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour) Hours not used in this code

'TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour) Hours not used in this code

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeMinRemaining & "m " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub
--
tia

Jock

Countdown timer
 

Jock,
I've completely done away with your Application.OnTime setup and usage. The
save and close is done within the same routine that handles the display of
time remaining. The two processes were not playing well together at all, and
it really isn't needed with this new code. Also, you can do away with the
"SaveAndCloseMe" code, where ever it is in your workbook. It's no longer
used.

All New code - will display correct time remaining, and is 'smart' in
determining if it needs to display Hours and/or Minutes or just seconds.
I've set this up for 20 seconds for quick testing - you can change the 20 to
1200 for 20 minutes.

'----------
'goes into Workbook's code module
'
'declared here so that it
'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
'20 minutes: 60*20 = 1200
Const TimeAllowed = 20 '7260 = 2hrs 1min, 1200 = 20 minutes

Private Sub Workbook_Open()
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = ""
If TimeHrsRemaining 0 Then
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
ElseIf TimeMinRemaining 0 Then
TimeDisplay = TimeMinRemaining & "M " & _
TimeCalc & "s"
Else
TimeDisplay = TimeCalc & "s"
End If

TimeDisplay = TimeDisplay & _
" before automatic save & close."

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' display Time Remaining

TimePassed = Timer
End If
DoEvents
Loop
Range(DisplayTimeRemainingInCell) = "Saving and Closing"
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close

End Sub
'--------------------

"Jock" wrote:

Sorry, I forgot to paste the altered code on my last reply; here it is:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'20 minutes
'calculated as (60*20) = 1200
Const TimeAllowed = 60 '60 = 1 min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

'TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour) Hours not used in this code

'TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour) Hours not used in this code

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeMinRemaining & "m " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub
--
tia

Jock

Countdown timer
 

J
Absolutely brilliant! Many thanks for your effrorts here, they are very much
appreciated. Appologies for the late response (bank holiday here)
Thanks again.
--
tia

Jock


"JLatham" wrote:

Jock,
I've completely done away with your Application.OnTime setup and usage. The
save and close is done within the same routine that handles the display of
time remaining. The two processes were not playing well together at all, and
it really isn't needed with this new code. Also, you can do away with the
"SaveAndCloseMe" code, where ever it is in your workbook. It's no longer
used.

All New code - will display correct time remaining, and is 'smart' in
determining if it needs to display Hours and/or Minutes or just seconds.
I've set this up for 20 seconds for quick testing - you can change the 20 to
1200 for 20 minutes.

'----------
'goes into Workbook's code module
'
'declared here so that it
'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
'20 minutes: 60*20 = 1200
Const TimeAllowed = 20 '7260 = 2hrs 1min, 1200 = 20 minutes

Private Sub Workbook_Open()
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = ""
If TimeHrsRemaining 0 Then
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
ElseIf TimeMinRemaining 0 Then
TimeDisplay = TimeMinRemaining & "M " & _
TimeCalc & "s"
Else
TimeDisplay = TimeCalc & "s"
End If

TimeDisplay = TimeDisplay & _
" before automatic save & close."

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' display Time Remaining

TimePassed = Timer
End If
DoEvents
Loop
Range(DisplayTimeRemainingInCell) = "Saving and Closing"
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close

End Sub
'--------------------

"Jock" wrote:

Sorry, I forgot to paste the altered code on my last reply; here it is:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'20 minutes
'calculated as (60*20) = 1200
Const TimeAllowed = 60 '60 = 1 min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

'TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour) Hours not used in this code

'TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour) Hours not used in this code

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeMinRemaining & "m " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub
--
tia

Jock

Countdown timer
 

You're welcome.

"Jock" wrote:

J
Absolutely brilliant! Many thanks for your effrorts here, they are very much
appreciated. Appologies for the late response (bank holiday here)
Thanks again.
--
tia

Jock


"JLatham" wrote:

Jock,
I've completely done away with your Application.OnTime setup and usage. The
save and close is done within the same routine that handles the display of
time remaining. The two processes were not playing well together at all, and
it really isn't needed with this new code. Also, you can do away with the
"SaveAndCloseMe" code, where ever it is in your workbook. It's no longer
used.

All New code - will display correct time remaining, and is 'smart' in
determining if it needs to display Hours and/or Minutes or just seconds.
I've set this up for 20 seconds for quick testing - you can change the 20 to
1200 for 20 minutes.

'----------
'goes into Workbook's code module
'
'declared here so that it
'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
'20 minutes: 60*20 = 1200
Const TimeAllowed = 20 '7260 = 2hrs 1min, 1200 = 20 minutes

Private Sub Workbook_Open()
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = ""
If TimeHrsRemaining 0 Then
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
ElseIf TimeMinRemaining 0 Then
TimeDisplay = TimeMinRemaining & "M " & _
TimeCalc & "s"
Else
TimeDisplay = TimeCalc & "s"
End If

TimeDisplay = TimeDisplay & _
" before automatic save & close."

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' display Time Remaining

TimePassed = Timer
End If
DoEvents
Loop
Range(DisplayTimeRemainingInCell) = "Saving and Closing"
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close

End Sub
'--------------------

"Jock" wrote:

Sorry, I forgot to paste the altered code on my last reply; here it is:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'20 minutes
'calculated as (60*20) = 1200
Const TimeAllowed = 60 '60 = 1 min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

'TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour) Hours not used in this code

'TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour) Hours not used in this code

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeMinRemaining & "m " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub
--
tia

Jock

Countdown timer
 

Hi J.
Just an update on this project.
I have noticed that if any other Excel workbook is open on the same pc, then
the countdown timer appears in I1 in the other workbooks too. Should any
workbook be open which has locked cells (ie I1), then the vba fails when that
worksheet gets focus.
If there is more that one excel book open, then clicking the tab in the task
bar to go to another does nothing. The only way to 'tab' between workbooks is
to use the 'Window' menu item and select a book from there. Should you try to
open another workbook, then nothing happens until the countdown timer code is
halted.
When the timer reaches 0, only the first opened workbook (with timer code)
closes down. The others remain open.

Is there a way to limit the code to one worhsheet only?

Thanks,

Jock


"JLatham" wrote:

Jock,
I've completely done away with your Application.OnTime setup and usage. The
save and close is done within the same routine that handles the display of
time remaining. The two processes were not playing well together at all, and
it really isn't needed with this new code. Also, you can do away with the
"SaveAndCloseMe" code, where ever it is in your workbook. It's no longer
used.

All New code - will display correct time remaining, and is 'smart' in
determining if it needs to display Hours and/or Minutes or just seconds.
I've set this up for 20 seconds for quick testing - you can change the 20 to
1200 for 20 minutes.

'----------
'goes into Workbook's code module
'
'declared here so that it
'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'2 hrs, 1 minute
'calculated as (60*60*2)+60 = 7260
'20 minutes: 60*20 = 1200
Const TimeAllowed = 20 '7260 = 2hrs 1min, 1200 = 20 minutes

Private Sub Workbook_Open()
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour)

TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour)

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = ""
If TimeHrsRemaining 0 Then
TimeDisplay = TimeHrsRemaining & _
"H " & TimeMinRemaining & "M " & _
TimeCalc & "s"
ElseIf TimeMinRemaining 0 Then
TimeDisplay = TimeMinRemaining & "M " & _
TimeCalc & "s"
Else
TimeDisplay = TimeCalc & "s"
End If

TimeDisplay = TimeDisplay & _
" before automatic save & close."

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' display Time Remaining

TimePassed = Timer
End If
DoEvents
Loop
Range(DisplayTimeRemainingInCell) = "Saving and Closing"
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close

End Sub
'--------------------

"Jock" wrote:

Sorry, I forgot to paste the altered code on my last reply; here it is:

'declared here so that it
'can be managed in this one
'location and referenced by
'any Sub/Function in this
'code module
'this is the cell address
'to display time remaining in
'on all sheets
Const DisplayTimeRemainingInCell = "$I$1"

'change TimeAllowed value to # of seconds before shutdown
'1 'tick' = 1 second, so
'20 minutes
'calculated as (60*20) = 1200
Const TimeAllowed = 60 '60 = 1 min

'this declared here for 'centralized' management
'if a change is ever needed
Const TimedEventDelay = "01:00"

Private Sub Workbook_Open()
Dim RunTime As Variant

RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"
'call this so that time remaining will be
'displayed even if they only open the workbook
'and never do anything with it after that.
'
'NOTE: once DisplayTimeRemaining is called
'it will continue to run for as long as the
'workbook is open.
'If/when you need to make code changes in
'this workbook, you will need to use
' Run | Reset from the VB menu bar or
' click the [Reset] icon in the VB icon toolbar
'in order to stop the routine and edit your code.
'
DisplayTimeRemaining
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
'change this next one to the cell address that you want
'the time remaining to be displayed in on all sheets

'we do not want to reset things if the
'change is just a time update in cell
'
If Target.Address = DisplayTimeRemainingInCell Then
Exit Sub ' do nothing!
End If

'call routine to display time remaining
'and setup the 'shutdown' event
DisplayTimeRemaining
End Sub

Private Sub DisplayTimeRemaining()
Dim RunTime As Variant

'do not alter these constants
Const SecsPerHour = 3600
Const SecsPerMinute = 60
Dim TimePassed As Long
Dim StopTime As Long
Dim TimeRemaining As Long
Dim TimeCalc As Long
Dim TimeHrsRemaining As Integer
Dim TimeMinRemaining As Integer
Dim TimeDisplay As String

On Error Resume Next
'can cause error if debugging/coding in progress
Application.OnTime RunTime, "SaveAndCloseMe", , False
If Err < 0 Then
Err.Clear
End If
On Error GoTo 0 ' clear error trapping
RunTime = Now() + TimeValue(TimedEventDelay)
Application.OnTime RunTime, "SaveAndCloseMe"

'set up the countdown
TimePassed = Timer
StopTime = TimePassed + TimeAllowed
TimeRemaining = TimeAllowed
'start the countdown
Do While Timer <= StopTime
If Timer TimePassed + 1 Then
TimeRemaining = TimeRemaining - 1
TimeCalc = TimeRemaining

'TimeHrsRemaining = _
Int(TimeCalc / SecsPerHour) Hours not used in this code

'TimeCalc = TimeCalc - _
(TimeHrsRemaining * SecsPerHour) Hours not used in this code

TimeMinRemaining = _
Int(TimeCalc / SecsPerMinute)

TimeCalc = TimeCalc - _
(TimeMinRemaining * SecsPerMinute)

TimeDisplay = TimeMinRemaining & "m " & _
TimeCalc & "s"

Range(DisplayTimeRemainingInCell) = _
TimeDisplay ' TimeRemaining

TimePassed = Timer
End If
DoEvents
Loop

End Sub
--
tia

Jock