Could someone offer an insight into why this crashes my excel, i cant seem to work it out. Im trying to learn VBA and need some advice.
sub timer()
dim second
second = 1.15740740740741e-05
'this is the amount excel counts as a second
line1:
application.wait "00:00:01"
Range("a1").value = Range("a1").value - second
if not range("D2").value = 0 then
Goto line1
else
Msgbox("Countdown ended")
End if
end sub
I'm sure you're not timing space shuttle launches or anything that critical. But if you want to make sure your countdown doesn't take longer than 30 seconds, you can use the Timer function. Here's an example.
Sub NewTimer()
Dim Start As Single
Dim Cell As Range
Dim CountDown As Date
'Timer is the number of seconds since midnight.
'Store timer at this point in a variable
Start = Timer
'Store A1 in a variable to make it easier to refer
'to it later. Also, if the cell changes, you only
'have to change it in one place
Set Cell = Sheet1.Range("A1")
'This is the starting value. Timeserial is a good
'way to get a time
CountDown = TimeSerial(0, 0, 30)
'Set our cell to the starting value
Cell.Value = CountDown
'Keep executing this loop until A1 hits zero or
'even falls slightly below zero
Do While Cell.Value > 0
'Update the cell. Timer - Start is the number of seconds
'that have elapsed since we set Start.
Cell.Value = CountDown - TimeSerial(0, 0, Timer - Start)
'DoEvents release control ever so briefly to Windows. This
'allows Windows to do stuff like update the screen. When you
'have loops like this, your code appears frozen because it's
'not letting Windows do anything (unless you have this line)
DoEvents
Loop
End Sub
If it just about count down every second, I guess there is another option to add a Timer functionality to Excel. Try searching for Application.OnTime function in Excel that enables us to have Timer in Excel. Related Article that explains how to add timer in Excel and make a macro run during that scheduled interval.
This is the best way to do this.
Try to use this code below:
Sub Countup()
Dim CountDown As Date
CountDown = Now + TimeValue("00:00:01")
Application.OnTime CountDown, "Realcount"
End Sub
Sub Realcount() 'Run this to count down your cell value
Dim count As Range
Set count = [E1] 'Put the range that you want to count down
count.Value = count.Value - TimeSerial(0, 0, 1)
If count <= 0 Then
MsgBox "Countdown complete."
Exit Sub
End If
Call Countup
End Sub
