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
Related
when one of my staff travel, they are entitled to travel comptime. My access vba already compares the date/time of departure to date/time of arrival at work site. How can I subtract the work hours from the flight time? to make matters even crazier, I have to account for time zones.
here the example I am working with (because if I an get this, the rest will fall into line).
staff departs Manila Philippines (UTC 8) on 3/7/22 at 00:15, arrives Washington DC (UTC -5) 3/7/22 at 16:10. total flight time is 1735 minutes (28 hours 55 minutes). Since the flight was over the workday, I need to subtract 480 minutes from the flight time.
How can I code this to date/time compare the workday and the flight date/time depart and date/time arrive to subtract out the 480 minutes of the workday?
I know the code i have attached may have "air code", but I am not a programmer by trade, just a guy trying to help his staff earn the most comptime they can.
depflt = MsgBox("Was day of departure a workday?", vbQuestion + vbYesNo)
If depflt = vbYes Then
If DTDeptdy < Strworkday Then
Me.TxtholdtimeDiff = DateRound(DTDeptdy - Strworkday, 0, 15, 0)
Me.TxtholdtimeDiff = Format(Me.TxtholdtimeDiff, "h") * 60 + Format(Me.TxtholdtimeDiff, "n")
pda = Me.TxtholdtimeDiff
'Me.TxtHoldTrvAirport = DateRound(arvairport - gotoairport, 0, 15, 0)
'Me.TxtHoldTrvAirport = Format(Me.TxtHoldTrvAirport, "h") * 60 + Format(Me.TxtHoldTrvAirport, "n")
Trvdiff = Me.TxtHoldTrvAirport
Else
If DTDeptdy > Strworkday And DTDeptdy < Endworkday Then
pda = 0
Else
If DTDeptdy > Endworkday Then
Me.TxtholdtimeDiff = DateRound(DTDeptdy - Endworkday, 0, 15, 0)
Me.TxtholdtimeDiff = Format(Me.TxtholdtimeDiff, "h") * 60 + Format(Me.TxtholdtimeDiff, "n")
pda = Me.TxtholdtimeDiff
Me.TxtHoldTrvAirport = DateRound(arvairport - gotoairport, 0, 15, 0)
Me.TxtHoldTrvAirport = Format(Me.TxtHoldTrvAirport, "h") * 60 + Format(Me.TxtHoldTrvAirport, "n")
Trvdiff = Me.TxtHoldTrvAirport
If pda >= 180 Then
pda = 180
End If
End If
End If
End If
Else
Me.TxtHoldTrvAirport = DateRound(arvairport - gotoairport, 0, 15, 0)
Me.TxtHoldTrvAirport = Format(Me.TxtHoldTrvAirport, "h") * 60 + Format(Me.TxtHoldTrvAirport, "n")
Trvdiff = Me.TxtHoldTrvAirport
pda = 180
End If
'sets variable to arrival date/time of flight
DTArvtdy = DateValue(Me.txtDateArvTDY) + TimeValue(Me.txtTimeFltArv)
If txtDateArvTDY = txtDateDepTDY And DTArvtdy < Strworkday Or DTArvtdy > endoworkday Then
arvtime = Me.txtArvAllowance * 60
Else
arvtime = 0
End If
' determine the number of hours between date depart tdy and date arrive tdy
Me!txtHoldTime = DateRound(DTArvtdy - DTDeptdy, 0, 15, 0)
Me!txtHoldTime = Format(Me.txtHoldTime, "h") * 60 + Format(Me.txtHoldTime, "n")
' determine time diff between date arrived tdy and date depart tdy
TimeDiff = DateDiff("d", DTDeptdy, DTArvtdy)
TimeDiff = TimeDiff * 24 * 60
' determine time zone value if TimeDiff >=1
If TimeDiff <> 1 Then
tzvalue = TxtDutyStationUTC.Value - TxtTDYLocUTC.Value
If tzvalue >= 1 Then
tzvalue = tzvalue * 60
Else
tzvalue = -tzvalue * 60
End If
End If
'sums the total time span
totmindep = arvtime + pda + tzvalue + Me.txtHoldTime + Trvdiff + TimeDiff + pdaDep
If totmindep < 0 Then
totmindep = 0
Else
totmindep = totmindep - workdaymin
End If
'determines the actually allowable travel comptime.
'totalCTDep = Format(totmindep \ 60, "0") & ":" & Format(totmindep Mod 60, "00")
' sets the textbox to the total allowable travel time
' txtCTHADOD.SetFocus
' txtCTHADOD.Text = totalCTDep
' holds the total time on the outward leg of the journey for use later in the program
mytempvar = totmindep
' used to store total CompTime hours earned departing on TDY
Me.TxtHoldHoursDep = mytempvar / 60
I used this code to check if the dates are more than 24 hours apart:
// determine time diff between date arrived tdy and date depart tdy
TimeDiff = DateDiff("d", DTDeptdy, DTArvtdy)
TimeDiff = TimeDiff * 24 * 60
If depflt = vbYes And TimeDiff = 1 Then
noCTforworkday = -480
End If
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")
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
At the begging I want tell you that I just read a lot of stack's about it and I didnt find solution so...
I'm substracting two dates
1 - 2017/05/05 17:00
2 - 2017/05/09 18:00
I want to receive "4 Days 1 Hour"
How I should do it? I tried to use DateFormat/Format/DateDiff and a lot of things.
It doesn't always have to be a ready-made VBA function. Especially with dates, I rarely find what I want exactly as VBA-ready. Try this custom function:
Function myDateDiff(ByVal d1 As Date, ByVal d2 As Date) As String
Dim days As Long, hours As Long
days = DateDiff("d", d1, d2) ' diff in days
hours = DateDiff("h", d1, d2) - days * 24 ' diff in hours
myDateDiff = days & " Day" & IIf(days > 1, "s ", " ") & hours & " Hour" & IIf(hours > 1, "s", "")
End Function
Sub Test()
Dim d1 As Date, d2 As Date
d1 = CDate("2017/05/05 17:00")
d2 = CDate("2017/05/09 18:00")
Debug.Print myDateDiff(d1, d2) ' 4 Days 1 Hour
d1 = CDate("2017/05/05 17:00")
d2 = CDate("2017/05/06 19:00")
Debug.Print myDateDiff(d1, d2) ' 1 Day 2 Hours
End Sub
This is the follow up post of this question and this question
I have created the following VBA function to calculate the seconds(also count the milliseconds) from two datetime.
Function:
Public Function ConvertDate(D1 As String, D2 As String) As Date
Dim StrD1 As Date
Dim StrD2 As Date
StrD1 = CDate(Left(D1, 10) & " " & Replace(Mid(D1, 12, 8), ".", ":"))
StrD2 = CDate(Left(D2, 10) & " " & Replace(Mid(D2, 12, 8), ".", ":"))
ConvertDate = DateDiff("s", StrD2, StrD1)
End Function
Scenario 1:
Given Dates:
2011-05-13-04.36.14.366004
2011-05-13-04.36.14.366005
Getting Result:
0
Expected Result:
0.000001
Scenario 2:
Given Dates:
2011-05-13-04.36.14.366004
2011-05-13-04.36.15.366005
Getting Result:
1
Expected Result:
1.000001
Scenario 3:
Given Dates:
2011-05-13-04.36.14.366004
2011-05-13-04.37.14.366005
Getting Result:
60
Expected Result:
60.000001
A day is 1. A date is 1 for every day past 31-Dec-1899. Today happens to be 42,556. Time is a decimal portion os a day. Today at noon will be 42,556.5 and today at 06:00 pm will be 42,556.75.
There are 24 hours in a day, 60 minutes in an hour and 60 seconds in a minute. That means that there are 86,400 seconds in a day (24 × 60 × 60) and a second is ¹⁄₈₆₄₀₀ (0.0000115740740740741) of a day. Excel's 15 digit floating point calculation sometimes fouls up (loses small amounts) time calculations due to the base-24 and base-60 numbering system.
Dim tm1 As String, tm2 As String
Dim dbl1 As Double, dbl2 As Double
Dim i As Long
With Worksheets("Sheet9")
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 2
tm1 = .Cells(i, "A").Text
tm2 = .Cells(i + 1, "A").Text
dbl1 = CLng(CDate(Left(tm1, 10))) + _
TimeValue(Replace(Mid(tm1, 12, 8), Chr(46), Chr(58))) + _
(CDbl(Mid(tm1, 20)) / 86400)
dbl2 = CLng(CDate(Left(tm2, 10))) + _
TimeValue(Replace(Mid(tm2, 12, 8), Chr(46), Chr(58))) + _
(CDbl(Mid(tm2, 20)) / 86400)
.Cells(i + 1, "B") = (dbl2 - dbl1) * 86400
.Cells(i + 1, "B").NumberFormat = "0.000000"
Next i
End With
The above takes your time-and-date-as-text and calculates a pseudo-DateDiff to an accuracy of a millionth of a second. The results are displayed in seconds as an integer with fractions of a second as a decimal.