Global time As Date
Sub countdown()
time = Now()
time = DateAdd("s", 120, time)
Do Until time < Now()
DoEvents
oSh.TextFrame.TextRange = Format((time - Now()), "ss")
Loop
End Sub
The timer starts from 60 and ends at 00. Then the same repeats. Is it possible to start the timer from 120 directly? How can we go about it?
Use DateDiff:
Global StopTime As Date
Sub countdown()
StopTime = DateAdd("s", 120, Now)
Do Until StopTime < Now
DoEvents
oSh.TextFrame.TextRange = DateDiff("s", Now, StopTime)
Loop
End Sub
Format will simply read the seconds from a date value, there is no way to "force" it to calculate the total seconds. However, it is rather easy to calculate it manually:
Dim delta as Date
delta = t - now
oSh.TextFrame.TextRange = Minute(d) * 60 + Second(d)
' or, if you want to have always 3 digits, eg 030
oSh.TextFrame.TextRange = Format(Minute(d) * 60 + Second(d), "000")
Related
I want to calculate the difference in hh:mm:ss between Now and column E. They both appear in format dd/mm/yyyy hh:mm. With the code I have written below, it only takes into consideration the hh:mm and not the days. So, if they have 2 days difference in wont add to the hours +48. The code is below:
With ws1.Range("N2:N" & lastrow1)
.Formula = "=TIME(HOUR(NOW()),MINUTE(NOW()),SECOND(NOW()))-TIME(HOUR(E2),MINUTE(E2),SECOND(32))"
End With
Just use =(NOW()-E2) and apply a custom format [hh]:mm:ss. The brackets around hh will do the trick.
If you rather need a number of hours, multiply by 24 as #Kerry Jackson suggested.
The logic behing date/time values is that 1 day = 1, so
1 hour = 1/24
1 min = 1/1440 '(that is 24*60 )
etc...
Put this in a module
Public Function DateTimeDiff(d1 As Date, d2 As Date)
Dim diff As Double
diff = ABS(d2 - d1)
DateTimeDiff = Fix(diff) & Format(diff, " hh:mm")
End Function
Then use
=DateTimeDiff( NOW(), E2 )
as the formula in the worksheet.
You might want to add some validation on the dates and return an error message if they are not valid.
Are you looking for a number which is the number of hours, or are you looking for text?
If you want the number of hours, try just subtracting the dates, and multiplying by 24, so the formula would be =(NOW()-E2)*24.
Public Function timeElapsed(ByVal target_cell As Range) As String
Dim hours As Long, minutes As Long, days As Long
If target_cell.Value = 0 Then Exit Function
x = DateDiff("n", target_cell, Now())
days = Format(Application.WorksheetFunction.RoundDown(x / 1440, 0), "00")
hours = Format(Application.WorksheetFunction.RoundDown((x - (days * 1440)) / 60, 0), "00")
minutes = Format(Application.WorksheetFunction.RoundDown((x - ((days * 1440) + (hours * 60))), 0), "00")
timeElapsed = CStr(days) & " " & "days" & " " & CStr(hours) & ":" & CStr(minutes)
End Function
And use as function with the result as below:
So you code becomes:
With ws1
.Range("N2:N" & lastrow1).FormulaR1C1 = "=timeElapsed(RC[-9])"
End With
I have to query reports based on the time given by me.
There are 4 slots of time: 0, 15, 30, 45.
Foe example, if the current time is 13:44, I will use time as 13:15 to 13:30 to query my reports; and if the current time is 13:04, I will use time as 12:30 to 13:45 to query my reports.
I have written the following code, but it uses lots of If and Else. Please help me with some better code.
Sub Test()
hh = Format(Time, "hh")
mm = Format(Time, "mm")
If (0 < mm < 15) Then mm = mm - 30
If (15 < mm < 30) Then mm = mm - 30
If (30 < mm < 45) Then mm = mm - 30
If (45 < mm < 60) Then mm = mm - 30
If (mm < 0) Then
mm = -mm
hr = hr - 1
End If
st = hh & "&" & mm
End Sub
You can use a little maths to round down to specific interval or bring the worksheet FLOOR function into play.
Option Explicit
Sub Test()
Dim tm As Double, st As String
tm = Application.Floor(Time, TimeSerial(0, 15, 0))
st = Format(tm, "hh\&mm")
Debug.Print st
End Sub
i want to repeat an event after a certain duration that is less than 1 second. I tried using the following code
Application.wait Now + TimeValue ("00:00:01")
But here the minimum delay time is one second. How to give a delay of say half a seond?
You can use an API call and Sleep:
Put this at the top of your module:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Then you can call it in a procedure like this:
Sub test()
Dim i As Long
For i = 1 To 10
Debug.Print Now()
Sleep 500 'wait 0.5 seconds
Next i
End Sub
I found this on another site not sure if it works or not.
Application.Wait Now + 1/(24*60*60.0*2)
the numerical value 1 = 1 day
1/24 is one hour
1/(24*60) is one minute
so 1/(24*60*60*2) is 1/2 second
You need to use a decimal point somewhere to force a floating point number
Source
Not sure if this will work worth a shot for milliseconds
Application.Wait (Now + 0.000001)
call waitfor(.005)
Sub WaitFor(NumOfSeconds As Single)
Dim SngSec as Single
SngSec=Timer + NumOfSeconds
Do while timer < sngsec
DoEvents
Loop
End sub
source
Timing Delays in VBA
I have try this and it works for me:
Private Sub DelayMs(ms As Long)
Debug.Print TimeValue(Now)
Application.Wait (Now + (ms * 0.00000001))
Debug.Print TimeValue(Now)
End Sub
Private Sub test()
Call DelayMs (2000) 'test code with delay of 2 seconds, see debug window
End Sub
Everyone tries Application.Wait, but that's not really reliable. If you ask it to wait for less than a second, you'll get anything between 0 and 1, but closer to 10 seconds. Here's a demonstration using a wait of 0.5 seconds:
Sub TestWait()
Dim i As Long
For i = 1 To 5
Dim t As Double
t = Timer
Application.Wait Now + TimeValue("0:00:00") / 2
Debug.Print Timer - t
Next
End Sub
Here's the output, an average of 0.0015625 seconds:
0
0
0
0.0078125
0
Admittedly, Timer may not be the ideal way to measure these events, but you get the idea.
The Timer approach is better:
Sub TestTimer()
Dim i As Long
For i = 1 To 5
Dim t As Double
t = Timer
Do Until Timer - t >= 0.5
DoEvents
Loop
Debug.Print Timer - t
Next
End Sub
And the results average is very close to 0.5 seconds:
0.5
0.5
0.5
0.5
0.5
Obviously an old post, but this seems to be working for me....
Application.Wait (Now + TimeValue("0:00:01") / 1000)
Divide by whatever you need. A tenth, a hundredth, etc. all seem to work. By removing the "divide by" portion, the macro does take longer to run, so therefore, with no errors present, I have to believe it works.
No answer helped me, so I build this.
' function Timestamp return current time in milliseconds.
' compatible with JSON or JavaScript Date objects.
Public Function Timestamp () As Currency
timestamp = (Round(Now(), 0) * 24 * 60 * 60 + Timer()) * 1000
End Function
' function Sleep let system execute other programs while the milliseconds are not elapsed.
Public Function Sleep(milliseconds As Currency)
If milliseconds < 0 Then Exit Function
Dim start As Currency
start = Timestamp ()
While (Timestamp () < milliseconds + start)
DoEvents
Wend
End Function
Note : In Excel 2007, Now() send Double with decimals to seconds, so i use Timer() to get milliseconds.
Note : Application.Wait() accept seconds and no under (i.e. Application.Wait(Now()) ↔ Application.Wait(Now()+100*millisecond)))
Note : Application.Wait() doesn't let system execute other program but hardly reduce performance. Prefer usage of DoEvents.
Otherwise you can create your own function then call it. It is important to use Double
Function sov(sekunder As Double) As Double
starting_time = Timer
Do
DoEvents
Loop Until (Timer - starting_time) >= sekunder
End Function
To pause for 0.8 of a second:
Sub main()
startTime = Timer
Do
Loop Until Timer - startTime >= 0.8
End Sub
Public Function CheckWholeNumber(Number As Double) As Boolean
If Number - Fix(Number) = 0 Then
CheckWholeNumber = True
End If
End Function
Public Sub TimeDelay(Days As Double, Hours As Double, Minutes As Double, Seconds As Double)
If CheckWholeNumber(Days) = False Then
Hours = Hours + (Days - Fix(Days)) * 24
Days = Fix(Days)
End If
If CheckWholeNumber(Hours) = False Then
Minutes = Minutes + (Hours - Fix(Hours)) * 60
Hours = Fix(Hours)
End If
If CheckWholeNumber(Minutes) = False Then
Seconds = Seconds + (Minutes - Fix(Minutes)) * 60
Minutes = Fix(Minutes)
End If
If Seconds >= 60 Then
Seconds = Seconds - 60
Minutes = Minutes + 1
End If
If Minutes >= 60 Then
Minutes = Minutes - 60
Hours = Hours + 1
End If
If Hours >= 24 Then
Hours = Hours - 24
Days = Days + 1
End If
Application.Wait _
( _
Now + _
TimeSerial(Hours + Days * 24, Minutes, 0) + _
Seconds * TimeSerial(0, 0, 1) _
)
End Sub
example:
call TimeDelay(1.9,23.9,59.9,59.9999999)
hopy you enjoy.
edit:
here's one without any additional functions, for people who like it being faster
Public Sub WaitTime(Days As Double, Hours As Double, Minutes As Double, Seconds As Double)
If Days - Fix(Days) > 0 Then
Hours = Hours + (Days - Fix(Days)) * 24
Days = Fix(Days)
End If
If Hours - Fix(Hours) > 0 Then
Minutes = Minutes + (Hours - Fix(Hours)) * 60
Hours = Fix(Hours)
End If
If Minutes - Fix(Minutes) > 0 Then
Seconds = Seconds + (Minutes - Fix(Minutes)) * 60
Minutes = Fix(Minutes)
End If
If Seconds >= 60 Then
Seconds = Seconds - 60
Minutes = Minutes + 1
End If
If Minutes >= 60 Then
Minutes = Minutes - 60
Hours = Hours + 1
End If
If Hours >= 24 Then
Hours = Hours - 24
Days = Days + 1
End If
Application.Wait _
( _
Now + _
TimeSerial(Hours + Days * 24, Minutes, 0) + _
Seconds * TimeSerial(0, 0, 1) _
)
End Sub
I just want to calculate the time that Dijkstra function will take to calculate shortest path for source node as the network nodes are in Q
Do While True
Dim dist As Integer = Integer.MaxValue
For i = 1 To Q.Count
If Q.Item(i).dist < dist Then
dist = Q.Item(i).dist
u = Q.Item(i)
End If
Next i
If dist = Integer.MaxValue Then Exit Do 'no more nodes available - done!
Q.Remove(u.name_t)
'loop over neighbors of u that are in Q
For j = 1 To Q.Count
For Each train In trains
If train.src.name_t = u.name_t And train.dst.name_t = Q.Item(j).name_t Then
alt = u.dist + train.t
If alt < Q.Item(j).dist Then
Q.Item(j).dist = alt
Q.Item(j).prev = u
End If
End If
Next
Next
Loop
try with this
Dim starttime As DateTime
Dim endtime As DateTime
Dim elapsed As Double
starttime = Format(Now(), "hh:mm:ss") 'beginning
'your code here
endtime = Format(Now(), "hh:mm:ss") 'end
Elapsed = DateDiff("s", starttime, endtime)
MsgBox("Finished in " & Elapsed & " seconds")
**EDIT 2 **
Sub time()
startTime = Timer
endtime = Timer
totalTime = Format(finishTime - startTime, "ss")
End Sub
Get the system date-time before and after function execution, then calculate the difference.
I have two strings with dates, I want to loop through the hours of the dates. I tried the following:
strStart = "15-01-2016 09:00"
strEnd = "16-01-2016 15:00"
j=0
for i = cdate(strStart) to cdate(strEnd)
msgbox(i)
j=j+1
next i
I also tried replacing cdate() in the for loop by timevalue(). At the end, I want my j to be 30. (15 hours of the first day and 15 of the second)
Use the DateAdd- and DateDiff-Functions for this:
dateStart = cDate(strStart)
dateEnd = cDate(strEnd)
j = 0
While DateDiff("h", dateStart, dateEnd) > 0
j=j+1
dateStart = DateAdd("h", 1, dateStart)
Wend
This way, you don't have to create a new Date for every loop, and you can easily access other date formats (days, minutes, years...)