excelvbatimertdontime

OnTime TimeStamp Value Doubling Up


When you launch RecordData() sub (from OpenMe() sub) just once it works perfectly. Each time stamp log is consecutive with no doubles. Its when the workbook, re-opens again (due to OpenMe()/Close() subs) is when it creates a duplicate time stamp log. Can I re-arrange the OnTime so it doesn't schedule a double for its next session? Or separate the two OnTime's somehow so their independent?

Dim NextTime As Double
Sub RecordData()
    Dim Interval As Double
    Dim cel As Range, Capture As Range

    Application.StatusBar = "Recording Started"
    Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
    With Worksheets("Journal") 'Record the data on this worksheet
        Set cel = .Range("A2") 'First timestamp goes here
        Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
        cel.Value = Now
        cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
    End With
    NextTime = Now + TimeValue("00:01:00")
    Application.OnTime NextTime, "RecordData"
End Sub

Sub StopRecordingData()
    Application.StatusBar = "Recording Stopped"
    Application.OnTime NextTime, "OpenMe", , False
End Sub

Sub OpenMe()
    Call RecordData
    Application.OnTime Now + TimeValue("00:10:00"), "CloseMe"
End Sub

Sub CloseMe()
    Application.OnTime Now + TimeValue("00:00:10"), "OpenMe"
    ThisWorkbook.Close True
End Sub

Solution

  • Here is an example wait sub:

    NOTE: This function is only available in excel.

    Option Explicit
    
    Dim vntNextTime As Variant
    Dim blnStopExecution As Boolean
    
    Const c_strTotalRecordDataWaitTime As String = "00:05:00"
    Const c_strCloseAndStopWaitTime As String = "00:00:30"
    
    
    'This should be on the same sheet as your button!
    Private Sub CommandButton1_Click()
        StopRecordingData
    End Sub
    
    'Private Sub WaitFor(intHrs As Integer, intMins As Integer, intSecs As Integer)
    '    Dim newHour As Integer
    '    Dim newMinute As Integer
    '    Dim newSecond As Integer
    '
    '    Dim waitTime As Variant
    '
    '    newHour = Hour(Now()) + intHrs
    '    newMinute = Minute(Now) + intMins
    '    newSecond = Second(Now()) + intSecs
    '
    '    waitTime = TimeSerial(newHour, newMinute, newSecond)
    '
    '    Application.Wait waitTime
    'End Sub
    
        Private Function CombineTime(intHrs As Integer, intMins As Integer, intSecs As Integer) As Long
            Dim lngTime As Long
    
            lngTime = intSecs + intMins * 60 + intHrs * 3600
            CombineTime = lngTime
        End Function
    
        Public Function GetTimeFromString(strInTime As String) As Long
            Dim strSplit() As String
            Dim intHrs As Integer
            Dim intMins As Integer
            Dim intSecs As Integer
    
            strSplit = Split(strInTime, ":")
            intHrs = CInt(strSplit(0))
            intMins = CInt(strSplit(1))
            intSecs = CInt(strSplit(2))
    
            GetTimeFromString = CombineTime(intHrs, intMins, intSecs)
        End Function
    
    
        Private Sub WaitFor(intHrs As Long, intMins As Long, intSecs As Long)
            Dim newHour As Integer
            Dim newMinute As Integer
            Dim newSecond As Integer
            Dim CurTime As Variant
    
            Dim waitTime As Variant
    
            newHour = Hour(Now()) + intHrs
            newMinute = Minute(Now) + intMins
            newSecond = Second(Now()) + intSecs
    
            waitTime = TimeSerial(newHour, newMinute, newSecond)
    
            'This is bad practice, but it will work for what you need.
            CurTime = 0
            Do While CurTime < waitTime
                newHour = Hour(Now())
                newMinute = Minute(Now)
                newSecond = Second(Now())
    
                CurTime = TimeSerial(newHour, newMinute, newSecond)
                DoEvents
                If blnStopExecution Then Exit Do
            Loop
            'Application.Wait waitTime
        End Sub
    
    
        Private Function GetNextTime(intHrs As Long, intMins As Long, intSecs As Long) As Variant
            Dim newHour As Integer
            Dim newMinute As Integer
            Dim newSecond As Integer
    
            Dim vntThisNextTime As Variant
    
            newHour = Hour(Now()) + intHrs
            newMinute = Minute(Now) + intMins
            newSecond = Second(Now()) + intSecs
    
            vntThisNextTime = TimeSerial(newHour, newMinute, newSecond)
    
            GetNextTime = vntThisNextTime
        End Function
    
        Private Sub RecordData()
            Dim Interval As Double
            Dim cel As Range, Capture As Range
            Dim intI As Integer
            Dim lngTimeStep As Long
    
            Application.StatusBar = "Recording Started"
    
            lngTimeStep = GetTimeFromString(c_strTotalRecordDataWaitTime) / 10
    
            For intI = 0 To 9
                WaitFor 0, 0, lngTimeStep
                If blnStopExecution Then Exit For
    
                Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
                With Worksheets("Journal") 'Record the data on this worksheet
                    Set cel = .Range("A2") 'First timestamp goes here
                    Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
                    cel.Value = Now
                    cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
                End With
            Next intI
        End Sub
    
        Public Sub OpenMe()
            blnStopExecution = False
            Call RecordData
            Call CloseMe
        End Sub
    
       Public Sub CloseMe()
            blnStopExecution = True
    
            vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
            Application.OnTime vntNextTime, "OpenMe"  'Now + TimeValue("00:00:10"), "OpenMe"
    
            ThisWorkbook.Close True
        End Sub
    
        Public Sub StopRecordingData()
            blnStopExecution = True
            Application.StatusBar = "Recording Stopped"
    
            vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
            Application.OnTime vntNextTime, "OpenMe"
        End Sub
    
    

    'I want to log/record the data in one minute intervals, then close the workbook 'in 10 minutes, and then reopen in 10 seconds