Pause a macro when the user starts entering a number in the active cell & resume it when they hit the Enter key

[Keith Mc 001]

BACKGROUND & CONTEXT: When the user hits a certain button, a macro is to begin by displaying (within a loop) the first of a sequence of random calculations (e.g., multiplication or addition) with two operands in the two cells immediately above the active cell in which the user is to enter their answer. When this loop begins, the timer allows the elapsed time to display continuously in another cell in the active worksheet. I want the elapsed time (& hence the macro) to PAUSE when the user starts hitting keystrokes & RESUME when the user hits the Enter key. Without this feature, while the macro is running I can't see the keystrokes that are being pressed until the whole number is entered & the timer keeps re-calculating the elapsed time, so it that continues to increase while the user's answer hasn't been finalized with the Enter key. I don't want the key pressing actions to form part of the elapsed time. The elapsed time is to increase again once the user has entered their answer (via the Enter key).

While the macro is on pause, the relevant calculation & the user's answer will be recorded in a TABLE (with an index). The macro should then resume by displaying another random calculation. The macro will loop through successive calculations & finally end after either (1) a prescribed time (during which time there may be dozens of calculations displayed & answered or (2) when a certain number of calculations have been answered.

WHAT I WANT HELP WITH is to be able to PAUSE THE MACRO (& hence the elapsing of time calculated from successive values of the timer, enabling also the user's non-Enter keystrokes to be displayed) UNTIL they hit the ENTER key to confirm their answer, at which point in time THE MACRO SHOULD RESUME. This sequence is to be repeated (with a new calculation) until a prescribed condition is met. It's ONLY the PAUSE & RESUME & the RELEVANT TRIGGERS I need help with.

 

[Keith Mc 001]

To begin to answer my own question, I've found "DoEvents" as a command to include within a macro to enable actions in Excel while the macro is running. I haven't tried it yet because I can't see how the macro knows when DoEvents is done with & the commands after DoEvents are to be performed. Perhaps the macro doesn't actually pause but continues running the whole time?

 

[Jaafar Tribak]

Yes DoEvents is necessary to interact with the worksheet while a loop is running but, detecting when the user starts entering data into the cell can be tricky. Perhaps you will need to jump over the timer and macro specific code whithout exiting the loop.

 

[Jaafar Tribak]

I have given this a shot and came up with this .
The timer is in seconds.

Hopefully, you can tweak it to your needs.

Download:
EditingWithTimer.xlsm





In a Standard Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

Private Type FmlaInfo
    wPointMode As Long
    #If Win64 Then
        Padding(24&) As Byte
    #Else
        Padding(20&) As Byte
    #End If
End Type

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare PtrSafe Function LPenHelper Lib "XLCALL32.DLL" (ByVal wCode As Long, FmlaInfo As Any) As Long
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    Private Declare Function LPenHelper Lib "XLCALL32.DLL" (ByVal wCode As Long, FmlaInfo As Any) As Long
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
#End If

Private sngStartTime As Single, sngElapsedTime As Single, sngTemp As Single
Private lElapsedSecs As Long
Private bTimerRunning As Boolean


Sub StartTimer()
    If bTimerRunning = False Then
        With Sheet1
            .Range("R_Timer").NumberFormat = "hh:mm:ss"
            .Range("R_Timer") = 0&
            .Range("R_Answer").ClearContents
            .Range("R_Op1") = Int((20& * Rnd) + 1&)
            .Range("R_Op2") = Int((10& * Rnd) + 1&)
        End With
        sngStartTime = Timer
        sngElapsedTime = 0!
        lElapsedSecs = 0&
        Call KillTimer(Application.hwnd, NULL_PTR)
        Call SetTimer(Application.hwnd, NULL_PTR, 0&, AddressOf TimerProc)
    End If
End Sub

Sub StopTimer()
    Call KillTimer(Application.hwnd, NULL_PTR)
    sngStartTime = 0!
    sngElapsedTime = 0!
    bTimerRunning = False
End Sub

Sub ClearHistory()
    On Error Resume Next
    Call StopTimer
    Sheet1.Range("R_Timer") = 0&
    With Sheet1.Range("G" & Sheet1.Rows.Count).End(xlUp)
        Sheet1.Range("G9:H" & .Row).Resize(.Row - 8&, 5&).ClearContents
        Sheet1.Range("G9:H" & .Row).Resize(.Row - 8&, 5&).Font.Color = 0&
    End With
End Sub



' ________________________________________ Private Routines _____________________________________________

Private Sub TimerProc()

    Const KEYEVENTF_KEYUP = &H2
    Static sngPrevElapsedTime As Single
    Static oEditCell As Range
    Static bEditMode As Boolean
    Dim hXlDesk As LongPtr

    On Error Resume Next
    bTimerRunning = True
    If Int(sngElapsedTime) >= Sheet1.Range("R_TimeOut") Then
        sngTemp = sngElapsedTime
        Call StopTimer
        MsgBox Int(sngTemp) & " Secs Timeout was reached!" & _
               vbNewLine & vbNewLine & "Please start the Timer again.", vbExclamation, "Time Is Up !!"
        bEditMode = False
        If IsEditMode Then
            Call keybd_event(vbKeyEscape, 0&, 0&, NULL_PTR)
            Call keybd_event(vbKeyEscape, 0&, KEYEVENTF_KEYUP, NULL_PTR)
        End If
        Call PopulateHistoryTable(True):  Exit Sub
    End If
    sngElapsedTime = Timer - sngStartTime

    If Not IsEditMode Then
        If bEditMode Then
            If oEditCell.Address = Sheet1.Range("R_Answer").Address Then
                bEditMode = False
                hXlDesk = FindWindowEx(Application.hwnd, NULL_PTR, "XLDESK", vbNullString)
                Call SetTimer(hXlDesk, NULL_PTR, 200&, AddressOf ForceEdit)
                sngStartTime = Timer
            End If
        End If
    Else
        bEditMode = True
        Set oEditCell = ActiveCell
    End If
   
    If Int(sngElapsedTime) - Int(sngPrevElapsedTime) >= 1& Then
        lElapsedSecs = sngElapsedTime
        Sheet1.Range("R_Timer").Formula = Format(Int(sngElapsedTime) / 86400, "hh:mm:ss")
    End If
   
    sngPrevElapsedTime = Int(sngElapsedTime)

End Sub

Private Sub ForceEdit()
    Dim hXlDesk As LongPtr
    hXlDesk = FindWindowEx(Application.hwnd, NULL_PTR, "XLDESK", vbNullString)
    Call KillTimer(hXlDesk, NULL_PTR)
    Call PopulateHistoryTable(False)
End Sub

Private Function IsEditMode() As Boolean
    Const xlModeReady = 0&, xlSpecial = &H4000, xlGetFmlaInfo = (14& Or xlSpecial)
    Dim tFInfo As FmlaInfo
    Call LPenHelper(xlGetFmlaInfo, tFInfo)
    If tFInfo.wPointMode <> xlModeReady Then
        IsEditMode = True
    End If
End Function

Private Sub PopulateHistoryTable(ByVal bTimeOut As Boolean)
    With Sheet1.Range("G" & Sheet1.Rows.Count).End(xlUp)
        .Offset(1&).Formula = .Offset(1).Row - 8&
        .Offset(1, 2&).Formula = Sheet1.Range("R_Op1")
        .Offset(1, 3&).Formula = Sheet1.Range("R_Op2")
        If bTimeOut Then
            .Offset(1, 4&).Formula = "No Answer - " & Sheet1.Range("R_TimeOut") & " [Secs] Time Up!"
            .Offset(1, 4&).Font.Color = vbRed
        Else
            .Offset(1, 1&).Formula = Sheet1.Range("R_Answer")
            .Offset(1, 4&).Formula = Format(lElapsedSecs / 86400, "hh:mm:ss")
            Sheet1.Range("R_Op1").Formula = Int((20& * Rnd) + 1&)
            Sheet1.Range("R_Op2").Formula = Int((10& * Rnd) + 1&)
        End If
    End With
End Sub