locked
[VBA] Multiple countdown timers - error when a number reaches zero RRS feed

  • Question

  • I'm trying to make multiple countdown timers in one sheet.
    Column A: On/Off switch
    Column B: is where countdown shows
    Column C: the length of the time that I want to countdown from
    Since it's MULTIPLE countdown timer, the Rows would look like, countdown timer 1, countdown timer 2, countdown timer 3....

    The problem is that the error occurs when a countdown reaches zero. How do I fix this?
    How do I make a switch change back to "OFF" when a countdown is done?


    ////Code for a switch
    
    Option Explicit
    
    Private Sub Line1_Click()
        If Line1.Caption = "Line 1: DOWN" Then
            Line1.Caption = "Line 1:   UP"
            Line1.ForeColor = vbRed
            Range("B2") = Range("C2")
            Timer
        Else
            Range("B2").Value = ""
            Line1.Caption = "Line 1: DOWN"
            Line1.ForeColor = vbBlack
        End If
    End Sub
    
    
    
    ///////Module codes
    
    Dim CountDown As Date
    
    Sub Timer()
        DisableTimer
        CountDown = Now + TimeValue("00:00:01")
        Application.OnTime CountDown, "Reset"
    End Sub
    
    
    Sub Reset()
    Dim Counter As Range
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
        If Evaluate("COUNT(B2:B5)") = 0 Then
            Call DisableTimer
        Else
            For Each Counter In ThisWorkbook.Sheets("Sheet1").Range("B2:B5")
                If Not IsEmpty(Counter) Then Counter = Counter - TimeValue("00:00:01")
            Next Counter
            Call Timer
        End If
        
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    End Sub
    
    
    Sub DisableTimer()
    On Error Resume Next
        
        Application.OnTime EarliestTime:=CountDown, Procedure:="Reset", Schedule:=False
        
    End Sub
    Source File: ttps://drive.google.com/open?id=0B5qMBYTNyqH_Q09ySnh3TElxNUU
    Tuesday, June 13, 2017 9:01 PM

All replies

  • The source file that I uploaded was saved in a wrong file type.  I uploaded it again, here's the new link, ttps://drive.google.com/open?id=0B5qMBYTNyqH_OEY5MTRWWURxS28

    Tuesday, June 13, 2017 9:26 PM
  • Hi voltaren1523,

    IsEmpty cant capture if the countdown reaches zero, you need empty the cell when the countdown reaches zero.

    Here is the example.

    For Each Counter In ThisWorkbook.Sheets("Sheet1").Range("B2:B5")
                If Not IsEmpty(Counter) Then
                    If Counter = 0 Then
                    Counter.Value = ""
                    Else
                    Counter = Counter - TimeValue("00:00:01")
                    End If
                End If
            Next Counter

    Besides, you could also reset switch button's Caption or ForeColor here.

    Best Regards,

    Wednesday, June 14, 2017 9:22 AM