Pause and Resume for Excel timer

[unfolgsamone]

Hi all,

I'm new to the forum and relatively new to VBA coding. I could really use some help.

I have a workbook with a timer that has start, stop and save buttons. My problem is that when the workbook is saved and reopened, the timer restarts at zero when the Start button is pressed. I need a pause and resume button instead of a Stop so that when the workbook is reopened the timer can resume where it left off. I've tried a half a dozen things on my own and have had zero luck achieving this end. Any help is appreciated.

Here is my current code:

Dim StopTimer            As Boolean
Dim SchdTime            As Variant
Dim Etime                 As Date
Const OneSec            As Date = 1 / 86400#

Private Sub StartBtn_Click()
   
    Application.Cursor = xlNorthwestArrow
    StartBtn.BackColor = vbGreen
    StopBtn.BackColor = vbWhite
    StopTimer = False

      SchdTime = Now() + TimeValue("00:00:00")
      [h6].Value = Format(Etime, "hh:mm:ss")
   Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
  
End Sub

Private Sub StopBtn_click()
 
    StopBtn.BackColor = vbRed
    StartBtn.BackColor = vbWhite
    StopTimer = True
    Beep
    
End Sub

Sub NextTick()
 
   If StopTimer Then
      'Don't reschedule update
   Else
      SchdTime = SchdTime + OneSec
      [h6].Value = Format(Etime, "hh:mm:ss")
      Application.OnTime SchdTime, "Sheet1.NextTick"
      Etime = Etime + OneSec
      End If
       
End Sub


Sub GoSheetNext()
Dim wb As Workbook
Dim lSheets As Long
Dim lSheet As Long
Dim lMove As Long
Dim lNext As Long
 
Set wb = ActiveWorkbook
lSheets = wb.Sheets.Count
lSheet = ActiveSheet.Index
lMove = 1

With wb
    For lMove = 1 To lSheets - 1
        lNext = lSheet + lMove
        If lNext > lSheets Then
            lMove = 0
            lNext = 1
            lSheet = 1
        End If
        
        If .Sheets(lNext).Visible = True Then
            .Sheets(lNext).Select
            Exit For
        End If
    Next lMove
                
End With
 
End Sub

Sub GoSheetBack()
Dim wb As Workbook
Dim lSheets As Long
Dim lSheet As Long
Dim lMove As Long
Dim lNext As Long

Set wb = ActiveWorkbook
lSheets = wb.Sheets.Count
lSheet = ActiveSheet.Index
lMove = 1

With wb
    For lMove = 1 To lSheets - 1
        lNext = lSheet - lMove
        If lNext < 1 Then
            lMove = 0
            lNext = lSheets
            lSheet = lSheets
        End If
        
        If .Sheets(lNext).Visible = True Then
            .Sheets(lNext).Select
            Exit For
        End If
    Next lMove
        
End With

End Sub

'Save as Excel and PDF

Sub SaveBtn_click()

ChDir "c:\Users\Public\PublicDocuments"
ActiveWorkbook.SaveAs Filename:=Range("h4").Value, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ChDir "c:\Users\Public\PublicDocuments"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("c8").Value, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Application.DisplayAlerts = False
ActiveWorkbook.Close True
Application.DisplayAlerts = True
 
End Sub

[LJMetzger]

Hi unfolgsamone and welcome to ExcelForum,


Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Because this is your first post, I will attempt to answer your question.

I haven't tested your code, but it looks like it works OK. To do what you want:
a. Unrelated to your question, but you should probably stop the timer each time the workbook closes in module ThisWorkbook, Sub Workbook_BeforeClose().
b. When you close the workbook, it looks like you need to save the value of global variable Etime, which means you should also make sure the workbook gets saved each time you close the workbook. You can save the Etime value in a cell of your choice. You could alternately save it in a Workbook Built In Property or Custom Property of your choice.
c. When you open the Workbook, you can retrieve the value of Etime.
d. You will probably also need a routine to reset the value of Etime to 0.

The following thread solves a similar question, and uses a 'Built In Property' to save the value of 'Total Editing Time'. http://www.excelforum.com/excel-gene...ml#post3745324

If you have additional questions or problems with this, I suggest you upload a sample workbook. When you upload a sample workbook, you will usually get responses sooner, that are more correct.

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

Lewis

[Leith Ross]

Hello unfolgsamone,

Thanks for adding the code tags as Lewis asked you.

Posting your workbook will allow solutions to be tested before posting back the answer.

How To Post Your Workbook

1. At the bottom right of the Reply window, Click the button Go Advanced
2. At the top of the Your Message Window, in the first row of icons, Click the Paperclip icon.
3. Click the Add Files button at the top right in the dialog box. This displays the File Manager dialog.
4. Click the Select Files button at the bottom middle of the dialog.
5. In the new window Find the file you want to upload, select it, and Click Open.
6. You will now be back in the File Manager dialog. Click the bottom Middle button Upload File.
7. Wait until the file has completely uploaded before you exit the File Manager dialog.

[unfolgsamone]

I have attached sample file. I appreciate your guidance but I am still at a loss.

[LJMetzger]

Hi,

I modified your code very slightly, and added the ThisWorkbook module code. The easiest way to save the value was to use cell 'H6' on Sheet 1, which stores the value anyway. When the workbook opens, global variable Etime gets loaded with that value.

When the workbook closes, the file is automatically saved to save the Etime value.

Your original code (Module Sheet1), modifications in red:

Dim StopTimer           As Boolean
Public SchdTime         As Variant        'Public because ThisWorkbook needs access
Public Etime            As Date           'Public because ThisWorkbook needs access
Const OneSec            As Date = 1 / 86400#

Private Sub ResetBtn_Click()              'Added in case you want to reset the value to ZERO
  Call StopBtn_click
  Etime = 0
  [h6].Value = Format(Etime, "hh:mm:ss")
End Sub

ThisWorkbook Module code (all new):

Option Explicit

Private Sub Workbook_Open()
   'Retrieve the total Time 
   Sheet1.Etime = Sheet1.[h6].Value
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  'Save the workbook at closing in order to keep the total time
  
  'Turn off the timer scheduler
  On Error Resume Next
  Application.OnTime Sheet1.SchdTime, "Sheet1.NextTick", Schedule:=False
  On Error GoTo 0
   
  ThisWorkbook.Save
End Sub

Lewis