Countdown Timer on a Userform1

[Rajeshkumar R]

Thank You So Much!

[LJMetzger]

Hi Rajeshkumar R,

Try the attached mofied copy of your file which contains the following code using an API Timer (Application Programming Interfaces). I had problems using your Label (it did not display properly), so I had to replace it. Please note that the timer MUST be stopped (done by the code below) when the UserForm closes and before the file closes or Excel may crash.

In the ThisWorkbook code module:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call StopUserFormTimer
End Sub

In the UserForm1 Code module:

Option Explicit

Private Sub UserForm_Initialize()

  'Initialize the CountDown Timer Label
  With LabelCountDownTimer
    .Font = "Arial"
    .Font.Size = 42
    .Font.Bold = True
    .Caption = ""
    
    .BackColor = RGB(51, 102, 255) 'RGB(51, 102, 255) = ColorIndex 41 = Blue
    .BorderColor = RGB(51, 102, 255)
  End With
  
End Sub

Private Sub UserForm_Terminate()
  'This stops the 'UserForm Timer' when the UserForm is closing
  Call StopUserFormTimer
End Sub

Private Sub CommandButton1_Click()
  Call CloseUserForm1
End Sub

In Ordinary Code Module ModApiTimer:

Option Explicit
'Reference: http://www.mrexcel.com/forum/excel-questions/392397-problems-running-clock-worksheet-cell.html
'Thank you  Jaafar Tribak

'NOTE: This has not been tested in 64 bit Excel

#If VBA7 And Win64 Then
  'All of the Win64 lines are supposed to be RED in 32 bit Excel

  ' Returns an unsigned long pointer (nIDEvent) if the timer is created. Failure returns a zero.
  Private Declare PtrSafe Function SetTimer _
      Lib "User32.dll" _
          (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.dll" _
          (ByVal hWnd As LongPtr, _
           ByVal nIDEvent As LongPtr) _
      As Long

  Private lTimerIdUserForm As LongPtr

#Else

  ' Returns an unsigned long pointer (nIDEvent) if the timer is created. Failure returns a zero.
  Private Declare Function SetTimer _
      Lib "User32.dll" _
          (ByVal HWnd As Long, _
           ByVal nIDEvent As Long, _
           ByVal uElapse As Long, _
           ByVal lpTimerFunc As Long) _
      As Long

  Private Declare Function KillTimer _
      Lib "User32.dll" _
          (ByVal HWnd As Long, _
           ByVal nIDEvent As Long) _
      As Long

  Private lTimerIdUserForm As Long

#End If

 
'Global 'Target Workbook Close' Date and Time
Private xGblUserFormExpirationTimeInSeconds As Double

'Timer Repeat Rate
Private Const iTimerRepeatRateMILLISECONDS As Long = 500   '500 milliseconds = half of one second


''''''''''''''''''''''''''''''''''''''''''''''
'MsgBox Message
''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''
'File Expiration 'Date and Time' Code
''''''''''''''''''''''''''''''''''''''''''''''
Sub SetFileExpirationDateAndTime()

  'Put the 'Expiration Date and Time' in the cell
  'NOTE: Leading apostrophe formats the output as TEXT and not as a DATE
  Sheets("Sheet1").Range(sExpirationTimeADDRESS).Value = Format(myGblUserFormCloseDateAndTime, "hh:mm:ss")
        
End Sub


''''''''''''''''''''''''''''''''''''''''''''''
'UserForm Timer Code
''''''''''''''''''''''''''''''''''''''''''''''
Sub DisplayUserForm1()
  'This opens the UserForm (in NonModal [access to Excel allowed] and starts the 'UserForm Timer'

  'Initialize the CountDown Timer Number of Seconds Expiration Date and Time
  '0.49 seconds added for 'Start Up' delay
  xGblUserFormExpirationTimeInSeconds = Timer + 120# + 0.49
  
  Call StopUserFormTimer
  Call StartUserFormTimer
  'UserForm1.Show vbModal      'Locks out Excel
  UserForm1.Show vbModeless   'Allows access to Excel

End Sub

Sub CloseUserForm1()
  'This stops the 'UserForm Timer' and closes the UserForm
  Call StopUserFormTimer
  Unload UserForm1
End Sub


Sub StartUserFormTimer()
  'This starts a 'UserForm Timer' that will repeat until stopped
  lTimerIdUserForm = SetTimer(0, 0, iTimerRepeatRateMILLISECONDS, AddressOf UserFormTimerEventHandler)
End Sub

Sub StopUserFormTimer()
  'This stops the 'UserForm Timer'
  KillTimer 0, lTimerIdUserForm
End Sub

Private Sub UserFormTimerEventHandler()
  'This is triggered each time the 'UserForm Timer' expires
  
  Dim xSecondsNow As Double
  Dim xSecondsRemaining As Double
  
  
  'Get the Current Date and Time
  xSecondsNow = Timer

  'Calculate the Number of Seconds Remaining
  'NOTE: Excel stores time as fractions of a day (e.g. 0.25 = 6 hours)
  xSecondsRemaining = xGblUserFormExpirationTimeInSeconds - xSecondsNow
  
  'Display the Time Remaining if the time remaining is Positive
  'Otherwise Stop the CountDown Timer and Close the UserForm
  If xSecondsRemaining > 0 Then
    'Display the Number of Seconds Remaining
    'Do not display a value less than 1 second
    If xSecondsRemaining < 1# Then
      xSecondsRemaining = 1#
    End If
    UserForm1.LabelCountDownTimer.Caption = Format(xSecondsRemaining, "0")
  Else
    'Stop the CountDown Timer and Close the UserForm
    Call CloseUserForm1
  End If
  
End Sub

It is a best practice to declare all variables. If you misspell a variable in your code, VBA will silently assume it is a Variant variable and go on executing with no clue to you that you have a bug. Go to the VBA development window, click Tools, Options, and check "Require Variable Declaration." This will insert the following line at the top of all new modules:

Option Explicit

This option requires all variables to be declared and will give a compiler error for undeclared variables.

To access a Code Module in VBA:
a. 'Left Click' on any cell in the Excel Spreadsheet.
b. ALT-F11 to get to VBA.
c. CTRL-R to get project explorer (if it isn't already showing).
d. 'Double Click' on the module you want to access in the 'Project Explorer'.
e. Insert code into the module if needed. 'Option Explicit' should only appear ONCE at the top of the module.

Lewis

[Rajeshkumar R]

Dear LJMetzger,

Thank You So Much for your suggestions, It just Awesome!

And the way you had explained also, its very crystal clear and gave me some confident to learn more on this VBA...

Once again Thank You So Much!

Regards,
Rajeshkumar R