i have one cell (TimeOut) as Time (Short Time Format, 24 Hrs)
i have another cell (ShiftName) Text Filed
Required formula as below
if Me.TimeOut >=6.00 and <= 14.00 Then
Me.shiftName = "Morning Shift"
Else If Me.TimeOut >= 14.01 and <= 22.00 then
Me.ShiftMane = "Afternoon Shift"
Else
Me.ShiftName = "Night Shift"
Time is not numbers, so try:
Select Case Me!TimeOut.Value
Case < #06.00#
Me!ShiftName = "Night Shift"
Case <= #14.00#
Me!ShiftName = "Morning Shift"
Case <= #22.00#
Me!ShiftMane = "Afternoon Shift"
Case Else
Me!ShiftName = "Night Shift"
End Select
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
Trying to make a banner that changes through different segments of an allotted time. The different segments are 15, 20, 25 minutes. I have a setup page that the user can select the segment from a combobox. Then displays the workflow page Like so:
This is a sample of what the banner should do for a 15 minute segment (pseudo code):
When it starts (15 remaining)
TimeBanner = "Thinking Time"
After 1 minute (14 remaining)
TimeBanner = "Response Time"
after 10 minutes (3 remaining)
TimeBanner = "Refine and Improve"
after 14 minutes(1 remaining)
TimeBanner = "Submit"
after 15 minutes (0 remaining)
TimeBanner = "Time Up"
The timer works, but the the banner doesn't change
So I thought perhaps I just needed to add DoEvents, but it doesn't change
Here's the code
Option Explicit
Public interval As Date
Sub timer()
interval = Now + TimeValue("00:00:01")
If Sheets("VSS").Range("D1").Value = 0 Then Exit Sub
'Show the time elapsed
Sheets("VSS").Range("D1").Value = Sheets("VSS").Range("D1").Value - TimeValue("00:00:01")
DoEvents
Sheets("VSS").Range("E3").Value = TimeBanner(Sheets("ControlData").Range("A7").Value, Minute(Sheets("VSS").Range("D1").Value))
DoEvents
'Show the Time Banner matching the Elapsed Time
'MsgBox Minute(Sheets("VSS").Range("D1").Value)
Application.OnTime interval, "timer"
DoEvents
End Sub
Sub stop_timer()
'Only allow 'Stop' if the timer has started
Dim iMin As Integer
iMin = Left(Format(Sheets("VSS").Range("D1").Value, "mm:ss"), 2)
'i.e. if the time elapsed DOES NOT equal whatever they chose
'It means that the timer has started
If iMin <> Sheets("ControlData").Range("A7").Value Then
Application.OnTime EarliestTime:=interval, Procedure:="timer", Schedule:=False
End If
End Sub
Sub reset_timer()
Sheets("VSS").Range("D1").Value = "00:" & Sheets("ControlData").Range("A7").Value & ":00"
End Sub
Function TimeBanner(iTimeChosen As Integer, iElapsedTime As Integer) As String
Debug.Print "Time chosen: " & iTimeChosen & ", Elapsed " & dtElapsedTime
Select Case iTimeChosen
Case 25
Select Case iElapsedTime
Case Is <= 25
TimeBanner = "Thinking Time"
Case Is <= 23
TimeBanner = "Response Time"
Case Is <= 5
TimeBanner = "Refine and Improve"
Case Is <= 1
TimeBanner = "Submit"
Case 0
TimeBanner = "Time Up"
End Select
Case 20
Select Case iElapsedTime
Case Is <= 20
TimeBanner = "Thinking Time"
Case Is <= 18
TimeBanner = "Response Time"
Case Is <= 4
TimeBanner = "Refine and Improve"
Case Is <= 1
TimeBanner = "Submit"
Case Is = 0
TimeBanner = "Time Up"
End Select
Case 15
Select Case iElapsedTime
Case Is <= 15
TimeBanner = "Thinking Time"
Case Is <= 14
TimeBanner = "Response Time"
Case Is <= 3
TimeBanner = "Refine and Improve"
Case Is <= 1
TimeBanner = "Submit"
Case Is = 0
TimeBanner = "Time Up"
End Select
End Select
End Sub
Reverse the order of your case conditions. Case Is <= 25, for instance, will always fire for any number 25 and down, which is all of them, so your first condition is always executed.
The first case of you Select Case will always trigger before the subsequent cases. If Case Is < 14 then Case Is <=15 is also true.
Case 15
Select Case iElapsedTime
Case Is <= 15
TimeBanner = "Thinking Time"
Case Is <= 14
TimeBanner = "Response Time"
Case Is <= 3
TimeBanner = "Refine and Improve"
Case Is <= 1
TimeBanner = "Submit"
Case Is = 0
TimeBanner = "Time Up"
End Select
Removing the < signs will make the code work properly.
Function TimeBanner(iTimeChosen As Integer, iElapsedTime As Integer) As String
Debug.Print "Time chosen: " & iTimeChosen & ", Elapsed " & dtElapsedTime
Select Case iTimeChosen
Case 25
Select Case iElapsedTime
Case Is < 25
TimeBanner = "Thinking Time"
Case Is < 23
TimeBanner = "Response Time"
Case Is < 5
TimeBanner = "Refine and Improve"
Case Is < 1
TimeBanner = "Submit"
Case 0
TimeBanner = "Time Up"
End Select
Case 20
Select Case iElapsedTime
Case Is < 20
TimeBanner = "Thinking Time"
Case Is < 18
TimeBanner = "Response Time"
Case Is < 4
TimeBanner = "Refine and Improve"
Case Is < 1
TimeBanner = "Submit"
Case 0
TimeBanner = "Time Up"
End Select
Case 15
Select Case iElapsedTime
Case 15
TimeBanner = "Thinking Time"
Case Is < 14
TimeBanner = "Response Time"
Case Is < 3
TimeBanner = "Refine and Improve"
Case Is < 1
TimeBanner = "Submit"
Case 0
TimeBanner = "Time Up"
End Select
End Select
End Function
Program is actually so simple but fails to execute when I enter a date like 09/21/1993. A person who's born on that date is obviously under 25 but output is "YES" because of 2018-1993=25. How do I prevent that?
dateOfBirth = CDate(txtBirth.Text)
a = (DateDiff(DateInterval.Year, dateOfBirth, Today))
If a < 25 Then
txt25.Text = "NO"
Else
txt25.Text = "YES"
Ok I just figured out.
dateOfBirth = CDate(txtBirth.Text)
b = dateOfBirth.AddYears(25)
a = CInt(DateDiff(DateInterval.Day, Today, b))
If a < 0 Then
txt25.Text = "NO"
Else
txt25.Text = "YES"
I'm having a bit of a headache when it comes to VBA. I had tried to search online for an answer but to no luck. I have learned Python, but VBA is a different ballpark.
Dim X As String
Function GRADELETTER_PM(Num_Grade As Double)
X = "A"
If Num_Grade >= 0.93 Then 'finds corresponding letter to a grade'
X = "A"
MsgBox X
End If
If Num_Grade >= 0.9 Then
X = "A-"
End If
If Num_Grade >= 0.88 Then
X = "B+"
End If
If Num_Grade >= 0.83 Then
X = "B"
End If
If Num_Grade >= 0.8 Then
X = "B-"
End If
If Num_Grade >= 0.78 Then
X = "C+"
End If
If Num_Grade >= 0.73 Then
X = "C"
End If
If Num_Grade >= 0.7 Then
X = "C-"
End If
If Num_Grade >= 0.67 Then
X = "D+"
End If
If Num_Grade >= 0.6 Then
X = "D"
End If
If Num_Grade < 0.6 Then
X = "F"
End If
End Function
The program is supposed to calculate a grade to its letter. IE a 93% (input) is an "A" (Output) while a 64% is a "D". The only input is the grade. The sheet itself has multiple tables that do not aline themselves perfectly (ie, not the same Col x Row) and the formula will be used 40+ times on that one sheet when it works. Thanks in advance.
I would suggest using a Select Case statement, for example:
Function GRADELETTER_PM(ByVal Num_Grade As Double) As String
Select Case Num_Grade
Case Is >= 0.93: GRADELETTER_PM = "A"
Case Is >= 0.9: GRADELETTER_PM = "A-"
Case Is >= 0.88: GRADELETTER_PM = "B+"
Case Is >= 0.83: GRADELETTER_PM = "B"
Case Is >= 0.8: GRADELETTER_PM = "B-"
Case Is >= 0.78: GRADELETTER_PM = "C+"
Case Is >= 0.73: GRADELETTER_PM = "C"
Case Is >= 0.7: GRADELETTER_PM = "C-"
Case Is >= 0.67: GRADELETTER_PM = "D+"
Case Is >= 0.6: GRADELETTER_PM = "D"
Case Else: GRADELETTER_PM = "F"
End Select
End Function
Here is a reference.
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