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
Related
I am creating a software which would find out the production complete date based on start date.
This will be working like it would find out the total hours required to complete the production and then add it to start date.
Now I want to add hours based on how the Production shift is working. These checkboxes tell that weather the shift is working or not. If checkbox is checked it means shift is working, otherwise not.
Based on shift working, it would add the hours to date, For example
Based on Calculation the time required is 900 hrs, now if Monday and Tuesday only one shift is working then while calculating end date it would consider only 12 hours from this 900 hrs for Monday and Tuesday.
Screenshot of WinForm
production24 = ((rpm * 24 * 60) / (pick * 39.37)) * (eff / 100)
production12 = ((rpm * addvalue * 60) / (pick * 39.37)) * (eff / 100)
production1 = ((rpm * 1 * 60) / (pick * 39.37)) * (eff / 100)
production24 = Math.Round(production24, 2, MidpointRounding.AwayFromZero)
production12 = Math.Round(production12, 2, MidpointRounding.AwayFromZero)
production1 = Math.Round(production1, 2, MidpointRounding.AwayFromZero)
pro_24.Text = Convert.ToString(production24)
Pro_12.Text = Convert.ToString(production12)
Pro_1.Text = Convert.ToString(production1)
If fl <> 0 And production1 <> 0 Then
timereqinhr = fl / production1
Else
timereqinhr = 0
End If
getdate = DatePicker.Value + Time_Picker.Value.TimeOfDay
falldate = getdate.AddHours(timereqinhr + offshift)
fallingtime.Text = falldate.ToString("dd/MM/yyyy | hh:mm tt")
Label9.Text = "Time required for " + fabric_Length.Text + " Meters"
Dim productiontime, productionhr, productionmin As String
productiontime = Math.Floor(timereqinhr / 24)
productionhr = Math.Floor(((timereqinhr / 24) - productiontime) * 24)
productionmin = Math.Floor(((((timereqinhr / 24) - productiontime) * 24) * 60) - (productionhr * 60))
Label8.Text = (productiontime + " Days, " + productionhr + " Hours " + productionmin + " Min ")
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 have a VBA function (DecTime) that I call passing in the value of a cell. The cell is formatted as custom hh:mm
in my cell the formula is "=DecTime(M6)"
If M6 is a time, eg 01:05 then it works fine, if it is null then I get #VALUE!
I am sure it's a simple solution but having spent the last hour trying lots of things from here and google I am baffled!
Here is my function :
Function DecTime(Optional time As Date = #12:00:00 AM#) As Single 'String
Dim Hours As Integer
Dim Minutes As Single
Dim HoursStr As String
Dim arrTime
'On Error Resume Next
'On Error GoTo error_handler
' HoursStr = Format(time, "h:mm")
' DecTime = HoursStr
If time = #12:00:00 AM# Then
' If HoursStr = "12:00" Then
' If IsEmpty(time) Then
' If IsEmpty(time) = True Then
' If IsNull(time) Then
' If arrTime.Count = 0 Then
' If InStr(0, time, ":") = 0 Then
' If IsDate(time) = False Then
DecTime = 88
' DecTime = HoursStr
Else
arrTime = Split(time, ":")
If arrTime(1) <= 0 Then
Minutes = 0
ElseIf arrTime(1) <= 5 Then
Minutes = 0.1
ElseIf arrTime(1) <= 10 Then
Minutes = 0.2
ElseIf arrTime(1) <= 15 Then
Minutes = 0.3
ElseIf arrTime(1) <= 20 Then
Minutes = 0.3
ElseIf arrTime(1) <= 25 Then
Minutes = 0.4
ElseIf arrTime(1) <= 30 Then
Minutes = 0.5
ElseIf arrTime(1) <= 35 Then
Minutes = 0.6
ElseIf arrTime(1) <= 40 Then
Minutes = 0.7
ElseIf arrTime(1) <= 45 Then
Minutes = 0.8
ElseIf arrTime(1) <= 50 Then
Minutes = 0.8
ElseIf arrTime(1) <= 55 Then
Minutes = 0.9
Else
Minutes = 0
End If
Hours = arrTime(0)
DecTime = Hours + Minutes
' DecTime = HoursStr
End If
'error_handler:
' DecTime = 99
'Resume Next
End Function
As you can see from the remarked code I have tried lots of different options to deal with a blank parameter passed in so if someone can tell me what I've done wrong I'd be very greatful!
I am a sql programmer so not much experience with VB
Assuming you want to return 0 if the cell is empty or doesn't contain a date, you could use:
Function DecTime(Optional time = #12:00:00 AM#) As Double
Dim Hours As Integer
Dim Minutes As Single
Dim arrTime
If Not IsDate(time) Then
DecTime = 0
ElseIf time = #12:00:00 AM# Then
DecTime = 0
Else
arrTime = Split(time, ":")
Select Case arrTime(1)
Case Is = 0
Minutes = 0
Case Is <= 5
Minutes = 0.1
Case Is <= 10
Minutes = 0.2
Case Is <= 20
Minutes = 0.3
Case Is <= 25
Minutes = 0.4
Case Is <= 30
Minutes = 0.5
Case Is <= 35
Minutes = 0.6
Case Is <= 40
Minutes = 0.7
Case Is <= 50
Minutes = 0.8
Case Is <= 55
Minutes = 0.9
Case Else
Minutes = 0
End Select
Hours = arrTime(0)
DecTime = Hours + Minutes
End If
End Function
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.
I am getting time as 23300000 i.e. hhMMssmm format as string
and I want to calculate difference of such two values.
Here hh is hours, MM is minutes, ss is seconds, and mm is 60th of second.
Using VBA for Excel 2003
This UDF will return the absolute value of the difference in seconds
Public Function tDiff(s1 As String, s2 As String) As Double
'
' calculates the absolute value of the differences
' returns the answer in seconds
'
Dim hrs As Double, mins As Double, secs As Double, sixt As Double
Dim tVal1 As Double, tVal2 As Double
hrs = CDbl(Mid(s1, 1, 2)) * 60 * 60
mins = CDbl(Mid(s1, 3, 2)) * 60
secs = CDbl(Mid(s1, 5, 2))
sixt = CDbl(Mid(s1, 7, 2)) / 60
tVal1 = hrs + mins + secs + sixt
hrs = CDbl(Mid(s2, 1, 2)) * 60 * 60
mins = CDbl(Mid(s2, 3, 2)) * 60
secs = CDbl(Mid(s2, 5, 2))
sixt = CDbl(Mid(s2, 7, 2)) / 60
tVal2 = hrs + mins + secs + sixt
If tVal1 > tVal2 Then
tDiff = tVal1 - tVal2
Else
tDiff = tVal2 - tVal1
End If
End Function
How about something like this:
Public Sub test()
Dim ms1 As Double
Dim ms2 As Double
ms1 = ToSeconds(23142700)
ms2 = ToSeconds(23311500)
Debug.Print "Difference between dates in seconds: " & ms2 - ms1
End Sub
Public Function ToSeconds(number As Long) As Double
Dim hh As Long
Dim mm As Long
Dim ss As Long
Dim ms As Long
ms = (number Mod (100 ^ 1)) / (100 ^ 0)
ss = (number Mod (100 ^ 2) - ms) / (100 ^ 1)
mm = (number Mod (100 ^ 3) - ss * (100 ^ 1) - ms) / (100 ^ 2)
hh = (number Mod (100 ^ 4) - mm * (100 ^ 2) - ss * (100 ^ 1) - ms) / (100 ^ 3)
ToSeconds = ms * 1 / 60 + ss + mm * 60 + hh * 60 * 60
End Function
The ToSeconds() function converts your number to seconds, and you can do your calculations based on that.
While this solution may not be as short as the others, I believe it is very easy to understand. Not everything here may be necessary, but you may find some of it useful in the future.
The run sub routine allows you to run the test function with your specified values.
The test function tests the timeDiff & timeSum logic.
The timeDiff function finds the time-difference between t1 and t0.
The timeSum function finds the time-sum of t1 and t0.
The asDuration function removes the AM/PM suffix from a time value.
The asMilitary function converts 12-hour format to 24 hour-format.
The concat function I created to more easily concatenate strings.
Sub Main() 'Run Test
MsgBox Test("0:29:0", "23:30:0")
End Sub
Function Test(startT As Date, endT As Date) 'Test timeDiff & timeSum logic
Dim nextShift As Date, prevShift As Date, hours As Date
hours = timeDiff(endT, startT)
prevShift = timeDiff(startT, "0:30:0")
nextShift = timeSum("0:30:0", endT)
Test = concat("Start -", startT, "", "End - ", endT, "", "Duration -", asDuration(hours), "", "Next Shift: ", nextShift, "", "Prev Shift: ", prevShift)
End Function
Function timeDiff(t1 As Date, t0 As Date) As Date 'Return Time1 minus Time0
Dim units(0 To 2) As String
units(0) = Hour(t1) - Hour(t0)
units(1) = Minute(t1) - Minute(t0)
units(2) = Second(t1) - Second(t0)
If units(2) < 0 Then
units(2) = units(2) + 60
units(1) = units(1) - 1
End If
If units(1) < 0 Then
units(1) = units(1) + 60
units(0) = units(0) - 1
End If
units(0) = IIf(units(0) < 0, units(0) + 24, units(0))
timeDiff = Join(units, ":")
End Function
Function timeSum(t1 As Date, t0 As Date) As Date 'Return Time1 plus Time0
Dim units(0 To 2) As String
units(0) = Hour(t1) + Hour(t0)
units(1) = Minute(t1) + Minute(t0)
units(2) = Second(t1) + Second(t0)
If units(2) >= 60 Then
units(2) = units(2) Mod 60
units(1) = units(1) + 1
End If
If units(1) >= 60 Then
units(1) = units(1) Mod 60
units(0) = units(0) + 1
End If
units(0) = IIf(units(0) >= 24, units(0) Mod 24, units(0))
timeSum = Join(units, ":")
End Function
Function asDuration(time As Date) As String 'Display as duration; Remove AM/PM suffix from time
time = asMilitary(time)
asDuration = Left(time, Len(time))
End Function
Function asMilitary(time As Date) As String 'Convert 12-hour format to 24-hour-format
asMilitary = Hour(time) & ":" & Minute(time) & ":" & Second(time)
End Function
Function concat(ParamArray var() As Variant) As String 'Return arguments of function call concatenated as a single string
For Each elem In var()
concat = IIf(elem <> "", concat & elem & " ", concat & vbNewLine)
Next
End Function