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
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
Hi I am getting the following error when computing GMT Time using nanoseconds as a long.
System.OverflowException: 'Arithmetic operation resulted in an overflow.'
Is there another data type that would work better with big values?
Private Sub gmtime(ByVal iSeconds As Object, ByVal iNanoseconds As Long, ByRef Timestamp As String)
Dim time As Object
Dim islpyr, lpcnt As Long
Dim t As Object
Dim i As Object
Dim ystart As Long
Dim y As Long
Dim sph As Object 'seconds per hour
Dim spd As Object 'seconds per day
Dim spy As Object 'seconds per year
Dim tm_sec As Long
Dim tm_min As Long
Dim tm_hour As Long
Dim tm_mday As Long
Dim tm_mon As Long
Dim tm_year As Long
Dim tm_wday As Long
Dim tm_yday As Long
Dim tm_isdst As Long
Dim mons(11) As Long
Dim temp As Object
Dim iMicroSeconds As Long
Dim iZeroCount As Long
Dim strZero As String
Dim strMicro As String
Dim iMicroData As Long
mons(0) = 31
mons(1) = 28
mons(2) = 31
mons(3) = 30
mons(4) = 31
mons(5) = 30
mons(6) = 31
mons(7) = 31
mons(8) = 30
mons(9) = 31
mons(10) = 30
mons(11) = 31
sph = CDec(60 * 60)
spd = CDec(24 * sph)
spy = CDec(365 * spd + 6 * sph) 'a year is about 365.25 days
tm_isdst = 0
time = CDec(iSeconds)
If time < 0 Then
time = time * (-1)
End If
i = CDec(time)
i = Fix(i / spd) Mod 7 + 4
While i >= 7
i = i - 7
End While
tm_wday = i
temp = Fix(time / spd)
temp = temp * spd
i = time - temp
tm_hour = Fix(i / sph) Mod 24
tm_min = Fix(i / 60) Mod 60
tm_sec = i Mod 60
y = Fix(time / spy)
y = y + 370
time = Fix(time / spd)
Do
islpyr = 0
If ((y Mod 4) = 0) And (((y Mod 100) <> 0) Or ((y Mod 400) = 0)) Then
islpyr = 1
End If
lpcnt = Fix(y / 4)
lpcnt = lpcnt - Fix(y / 100)
lpcnt = lpcnt + Fix(y / 400)
lpcnt = lpcnt - 89
ystart = (y - 370) * 365 + lpcnt
If ystart > time Then
y = y - 1
End If
Loop While ystart > time
time = time - ystart
If time = 365 Then
time = 0
y = y + 1
End If
If islpyr Then
time = time + 1
End If
tm_yday = time
time = time + 1
For i = 0 To 10
t = mons(i)
If (i = 1) And (islpyr = 1) Then
t = t + 1
End If
If time <= t Then
Exit For
End If
time = time - t
Next i
tm_year = y - 300 + 1900
tm_mon = i + 1
tm_mday = time
strZero = "."
iZeroCount = 6
iMicroSeconds = Fix(iNanoseconds / 1000)
iMicroData = iMicroSeconds
While iMicroSeconds <> 0
iMicroSeconds = Fix(iMicroSeconds / 10)
If (iMicroData Mod 10) = 0 Then
iMicroData = iMicroSeconds
End If
If iZeroCount <> 0 Then
iZeroCount = iZeroCount - 1
End If
End While
For i = 1 To iZeroCount
strZero = strZero + "0"
Next i
If Fix(iNanoseconds / 1000) <> 0 Then
strMicro = strZero + CStr(Fix(iNanoseconds / 1000))
Else
strMicro = strZero
End If
Timestamp = CStr(tm_year) + "-" + CStr(tm_mon) + "-" + CStr(tm_mday) + " " + CStr(tm_hour) + ":" + CStr(tm_min) + ":" + CStr(tm_sec) + strMicro
End Sub
It wouldn't let me add the code as the post is mostly code. The nanoseconds values are coming from a waveform file and this function is used to process it into GMT time.
The function is called on a loop for each line of the file and returns this error mid-way through the loop.
The value is '1.5518651852110167E+270' when it hits the error
I'm sorry but there's no way to put a 10^270 number inside ANY variable.
The biggest variable for numbers is Long that holds:
signed 64-bit (8-byte) integers ranging in value from
-9,223,372,036,854,775,808 through 9,223,372,036,854,775,807
(9.2...E+18).
From Long DataType
I sueggest you to avoiding counting time in nanoseconds instead use seconds, minutes, or even days if your TimeSpan is too big.
Counting time in nanoseconds is pointless.
Remarks
If you couldn't avoid using nanoseconds because your file is in nanoseconds your only option is to convert you nanoseconds value in a DateTime format on every line and hope that the value will be shorter than 9.2E+18
Otherwise you could use a BigInteger and use it to calculate a DateTime for every line of your file.
Just for the curiosity: You would need a 896 bytes unsigned DataType to store a 1.5*10^270 inside it.
Found a function on Excelguru which I changed a few things in and gonna edit some more. The idea is to use this to register worked hours and minutes.
There is one thing in this I don't understand: if I type the wrong time in the column reff I get a msg that its wrong, but it wont disappear unless I click it 10 times. I cant see what Im doing wrong. The entire code is posted and Im grateful for any help.
Use his function as part of the formula in the sheet like: TimeValue($E2;$F2;"16:00";"18:00";B2;9;C2)
Function TimeValue(FromTime As String, ToTime As String, StartTime As String, StopTime As String, Optional Weekday As String, Optional Daynr As Integer, Optional Holiday As String)
Dim x As Long
Dim F As Double
Dim T As Double
Dim Start As Double
Dim Stopp As Double
Dim Min As Long
Dim Day As Integer
Dim OverMid As Boolean
Select Case LCase(Weekday)
Case "mandag"
Day = 1
Case "tirsdag"
Day = 2
Case "onsdag"
Day = 3
Case "torsdag"
Day = 4
Case "fredag"
Day = 5
Case "lordag"
Day = 6
Case "sondag"
Day = 7
Case "x"
Day = 8
Case Else
Day = 0
End Select
OverMid = False
If LCase(Holiday) = "x" Then Day = 8
If Len(FromTime) = 0 Or Len(ToTime) = 0 Then
Exit Function
End If
If Len(FromTime) <> 5 Then
MsgBox ("Use format TT:MM - From time is wrong:" & FromTime)
Exit Function
End If
If Len(ToTime) <> 5 Then
MsgBox ("Use format TT:MM - To time is wrong:" & ToTime)
Exit Function
End If
F = Val(Left(FromTime, 2)) * 60 + Val(Right(FromTime, 2))
T = Val(Left(ToTime, 2)) * 60 + Val(Right(ToTime, 2))
Start = Val(Left(StartTime, 2)) * 60 + Val(Right(StartTime, 2))
Stopp = Val(Left(StopTime, 2)) * 60 + Val(Right(StopTime, 2))
If T = 0 Then T = 24 * 60
If T < F Then
T = T + 24 * 60
OverMid = True
End If
If Stopp = 0 Then Stopp = 24 * 60
For x = F + 1 To T
If x > Start And x <= Stopp Then
Min = Min + 1
End If
Next x
If OverMid = True Then
For x = 0 To Val(Left(ToTime, 2)) * 60 + Val(Right(ToTime, 2))
If x > Start And x <= Stopp Then
Min = Min + 1
End If
Next x
End If
'If weekday is set, equal to day
If Daynr <> 0 Then
If Daynr <> 9 Then
If Day <> Daynr Then Min = 0
End If
If Daynr = 9 And (Day > 5) Then
Min = 0
End If
End If
TimeValue = Min / 60
End Function
And the sub in the sheets
Private Sub Worksheet_Change(ByVal Target As Range)
Dim streng As String
Dim k As Long
Dim r As Long
k = Target.Column
r = Target.Row
If Cells(1, k) = "P" Then
If Cells(r, k) = "x" Then
Cells(r, 4) = "x"
Else
Cells(r, 4) = ""
End If
End If
End Sub
Message boxes really don't belong in UDFs (VBA functions meant to be used as spreadsheet functions).
Instead of the message box you could use code like:
If Len(FromTime) <> 5 Then
TimeValue = "Error! Use format TT:MM - From time is wrong:" & FromTime
Exit Function
Or perhaps:
If Len(FromTime) <> 5 Then
TimeValue = CVErr(xlErrValue)
Exit Function
This later will cause #VALUE! to display in the cell. Include enough documentation in your spreadsheet so that users can interpret such error values.
Here's basically what I have:
Public checkprogresstime_p1 As String = ""
Public checkprogresstime_p2 As String = ""
'P1 Progress bar updater
checkprogresstime_p1 = (time_total.Text - time_p1_hour.Value)
If checkprogresstime_p1 >= 60 Then
checkprogresstime_p1 = 60
time_p1_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p1 <= 0 Then
checkprogresstime_p1 = 1
End If
If time_p1_progress.Value < 60 Then
time_p1_progress.ForeColor = Color.Red
End If
time_p1_progress.Value = checkprogresstime_p1
Here's basically what I need:
Dim cnt As Integer = 1
Do
'P1 Progress bar updater
checkprogresstime_p(cnt) = (time_total.Text - time_p(cnt)_hour.Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p(cnt)_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p(cnt)_progress.Value < 60 Then
time_p(cnt)_progress.ForeColor = Color.Red
End If
time_p(cnt)_progress.Value = checkprogresstime_p(cnt)
Loop While cnt <= 25
I have no idea how to do it... I need it to loop and add +1, 25 times. I basically have it written out 25 times at the moment...
This is the For/Loop with your current request. The cnt variable will increment itself in this type of Loop.
For cnt As Integer = 1 To 25
'P1 Progress bar updater
checkprogresstime_p(cnt) = (time_total.Text - time_p(cnt)_hour.Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p(cnt)_progress.ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p(cnt)_progress.Value < 60 Then
time_p(cnt)_progress.ForeColor = Color.Red
End If
time_p(cnt)_progress.Value = checkprogresstime_p(cnt)
Next
I believe what you're wanting to do has more to do with having 25 progress bars on your form where each one is named time_p#_progress where # is the number of the progress bar. That being said, there are two ways to acheive updating your progress bars without having to copy and paste your code 25 times...
1. Use Me.Controls to get a reference to the progress bar
For j = 1 To 25
Dim pbar As ProgressBar = Me.Controls("time_p" & j & "_progress")
Dim ph As NumericUpDown = Me.Controls("time_p" & j & "_hour")
Dim checkprogresstime As Long = (time_total.Text - ph.Value)
If checkprogresstime >= 60 Then
checkprogresstime = 60
pbar.ForeColor = Color.LimeGreen
ElseIf checkprogresstime <= 0 Then
checkprogresstime = 1
End If
If time_p1_progress.Value < 60 Then
pbar.Value = checkprogresstime
End If
pbar.Value = checkprogresstime
Application.DoEvents()
Next
Note: You didn't tell us what type of control time_p1_hour was. I assumed it was a NumericUpDown down control. So, if it's not, you need to replace it the type of control that time_p1_hour is.
2. Dynamically create your controls as a control array
Initizliaze your progress bars in the Form1_Load method (MyBase.Load)
Private pbars(24) As ProgressBar
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
For i = LBound(pbars) To UBound(pbars)
pbars(i) = New ProgressBar()
pbars(i).Parent = Me
pbars(i).Top = i * pbars(i).Height
pbars(i).Left = 0
pbars(i).Visible = True
Next
End Sub
Put your code inside of a loop like so
For cnt = 0 To 24
checkprogresstime_p(cnt) = (time_total.Text - time_hour(cnt).Value)
If checkprogresstime_p(cnt) >= 60 Then
checkprogresstime_p(cnt) = 60
time_p_progress(cnt).ForeColor = Color.LimeGreen
ElseIf checkprogresstime_p(cnt) <= 0 Then
checkprogresstime_p(cnt) = 1
End If
If time_p_progress(cnt).Value < 60 Then
time_p_progress(cnt).ForeColor = Color.Red
End If
time_p_progress(cnt).Value = checkprogresstime_p(cnt)
Next
I'm building a little time > pay conversion program in VB. I'm really new to VB and don't understand why my variable pay doesn't calculate like it should. I plug in 5 5's as a test and get $0.
Dim total As Double = 0.0
Dim timeCounter As Integer = 0
Dim time As Integer = 0
Dim pay As Double = 0.0
While timeList.Items.Count < 5
time = timeList.Items(timeCounter)
total += time
timeCounter += 1
End While
If total >= 0 And total <= 40 Then
If total >= 0 And total <= 20 Then
pay = total * 10
ElseIf total >= 21 And total <= 30 Then
pay = total * 12
ElseIf total >= 31 And total <= 40 Then
pay = total * 15
Else
PayLabel.Text = "Error"
End If
End If
PayLabel.Text = "$" & pay
Your syntax should be something like this:
For intCount = 0 To timeList.Items.Count
time = timeList.Items(intCount)
total += time
Next intCount
This will avoid an infinite loop.
To fix your 40+ issue:
If total >= 0 And total <= 40 Then
If total >= 0 And total <= 20 Then
pay = total * 10
ElseIf total >= 21 And total <= 30 Then
pay = total * 12
ElseIf total >= 31 And total <= 40 Then
pay = total * 15
End If
Else
PayLabel.Text = "Error"
End If
this would be my fix into a console apps
for process will return $0, second $100
Module Module1
Sub Main()
Dim timeList As New List(Of Integer)
timeList.AddRange(New Integer() {1, 2, 3, 4, 5, 6})
process(timeList)
timeList.Clear()
timeList.AddRange(New Integer() {1, 2, 3, 4})
process(timeList)
Console.Read()
End Sub
Private Sub process(timeList As List(Of Integer))
Dim total As Double = 0.0
Dim timeCounter As Integer = 0
Dim time As Integer = 0
Dim pay As Double = 0.0
While timeList.Count < 5 AndAlso timeCounter < timeList.Count
time = timeList(timeCounter)
total += time
timeCounter += 1
End While
If total >= 0 And total <= 40 Then
If total >= 0 And total <= 20 Then
pay = total * 10
ElseIf total >= 21 And total <= 30 Then
pay = total * 12
ElseIf total >= 31 And total <= 40 Then
pay = total * 15
Else
Console.WriteLine("error")
End If
End If
Console.WriteLine("$" & pay)
End Sub
End Module
This could be better solved with a functional approach. To get the sum of the list of integers do the following:
Dim totalTime = timeList.Sum()
Then you can follow the logic you laid out. I would highly recommend learning to use Linq Set Functions to make your code your readable and easier to understand. Good Luck.