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 ")
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
Ok here's the deal: I need to do a comprehensive check in a .csv file (comparing the one in my current sheet to an external one). I decided to divide the list into 10 equal sections (deciles). In each decile I choose a random value belonging to that section and use that row number to compare the two sets of data.
Where things fall apart is inside the FOR function. I am looking for a way to go through each decile (starting from rand0) and have VBA check whether the values of the .csv and the Data sheet in this workbook are equal. If they are not - a function (called get_param) is to be executed.
I dont quite understand how to have VBA go through the FOR function from Dec = 0 to 9 - so in essence from row number rand0 to row number rand9 and perform the inequality check (in the second IF function). The rand & Dec part does not work. I am looking for clues on how to fix this or on a new implementation to do the same thing.
A few more details:
n is the number of rows in the .csv file (equal to a couple of thousand).
np is the number of rows in this file (should be equal to n - if not, execute function). ParamLocation is designated automatically - it should be located in a specific location.
Sub check_changes_param()
Dim Dec As Integer
Call public_dims
Call deciles
Set ParamBook = Workbooks.Open(ParamLocation)
'==========CHECKS IF PARAMETERS.xlsm EXISTS IN THE CORRECT LOCATION==========
If ParamLocation = "" Then
MsgBox "The Parameters.xlsm file does not exist or is in the incorrect location. Please ensure it is located in " & ParamLocation
Else
For Dec = 0 To Dec = 9
If ThisWorkbook.Sheets("Data").Cells(rand & Dec, 11) <> ParamBook.Sheets("Data").Cells(rand & Dec, 11) Or n <> np Then
Call get_param
Exit For
End If
Next Dec
End If
End Sub
Public Sub deciles()
rand0 = Int((n / 10) * 1) * Rnd + 1
rand1 = Int((n / 10) * 2 - (n / 10) * 1 + 1) * Rnd + (n / 10) * 1
rand2 = Int((n / 10) * 3 - (n / 10) * 2 + 1) * Rnd + (n / 10) * 2
rand3 = Int((n / 10) * 4 - (n / 10) * 3 + 1) * Rnd + (n / 10) * 3
rand4 = Int((n / 10) * 5 - (n / 10) * 4 + 1) * Rnd + (n / 10) * 4
rand5 = Int((n / 10) * 6 - (n / 10) * 5 + 1) * Rnd + (n / 10) * 5
rand6 = Int((n / 10) * 7 - (n / 10) * 6 + 1) * Rnd + (n / 10) * 6
rand7 = Int((n / 10) * 8 - (n / 10) * 7 + 1) * Rnd + (n / 10) * 7
rand8 = Int((n / 10) * 9 - (n / 10) * 8 + 1) * Rnd + (n / 10) * 8
rand9 = Int(n - (n / 10) * 9 + 1) * Rnd + (n / 10) * 9
End Sub
Try this instead:
Sub check_changes_param()
Dim Dec As Integer
Call public_dims
Dim deciles As Variant
deciles = decilesArray()
Set ParamBook = Workbooks.Open(ParamLocation)
'==========CHECKS IF PARAMETERS.xlsm EXISTS IN THE CORRECT LOCATION==========
If ParamLocation = "" Then
MsgBox "The Parameters.xlsm file does not exist or is in the incorrect location. Please ensure it is located in " & ParamLocation
Else
For Dec = 0 To UBound(deciles)
If ThisWorkbook.Sheets("Data").Cells(deciles(Dec), 11) <> ParamBook.Sheets("Data").Cells(deciles(Dec), , 11) Or n <> np Then
Call get_param
Exit For
End If
Next Dec
End If
End Sub
Public Function decilesArray() As Variant
randomize()
rand0 = Int((n / 10) * 1) * Rnd + 1
rand1 = Int((n / 10) * 2 - (n / 10) * 1 + 1) * Rnd + (n / 10) * 1
rand2 = Int((n / 10) * 3 - (n / 10) * 2 + 1) * Rnd + (n / 10) * 2
rand3 = Int((n / 10) * 4 - (n / 10) * 3 + 1) * Rnd + (n / 10) * 3
rand4 = Int((n / 10) * 5 - (n / 10) * 4 + 1) * Rnd + (n / 10) * 4
rand5 = Int((n / 10) * 6 - (n / 10) * 5 + 1) * Rnd + (n / 10) * 5
rand6 = Int((n / 10) * 7 - (n / 10) * 6 + 1) * Rnd + (n / 10) * 6
rand7 = Int((n / 10) * 8 - (n / 10) * 7 + 1) * Rnd + (n / 10) * 7
rand8 = Int((n / 10) * 9 - (n / 10) * 8 + 1) * Rnd + (n / 10) * 8
rand9 = Int(n - (n / 10) * 9 + 1) * Rnd + (n / 10) * 9
decilesArray= Array(rand0,rand1,rand2,rand3,rand4,rand5,rand6,rand7,rand8,rand9)
End Sub
I propose this correction,
public dim statements should be defined outside sub or functions.
use an array instead of concatenation to refer to a variable, rand & dec is not a correct VBA syntax to address rand0, ... rand9 variables.
Dim rand(9)
Sub check_changes_param()
Dim Dec As Integer, n
' Call public_dims ' put dim instructions as first instructions of this module
n = 10 'modify 10 to reflect correct value
Call deciles(n)
Set ParamBook = Workbooks.Open(ParamLocation)
'==========CHECKS IF PARAMETERS.xlsm EXISTS IN THE CORRECT LOCATION==========
If ParamLocation = "" Then
MsgBox "The Parameters.xlsm file does not exist or is in the incorrect location. Please ensure it is located in " & ParamLocation
Else
For Dec = 0 To 9
If ThisWorkbook.Sheets("Data").Cells(rand(Dec), 11) <> ParamBook.Sheets("Data").Cells(rand(Dec), 11) Or n <> np Then
Call get_param
Exit For
End If
Next Dec
End If
End Sub
Public Sub deciles(n)
rand(0) = Int((n / 10) * 1) * Rnd + 1
For i = 1 To 8
rand(i) = Int((n / 10) * (i + 1) - (n / 10) * (i + 1) + 1) * Rnd + (n / 10) * i
Next
rand(9) = Int(n - (n / 10) * 9 + 1) * Rnd + (n / 10) * 9
End Sub
I have a method I wrote in a VBA module
Public Function calcAscentTime()
IDepth = CInt(Sheets("Fundies").Range("B47"))
T = 0
T = T + 1 ' Add 1 minute for emergency
D = Math.Round((IDepth / 10) * 10) 'Round to Ceiling of nearest 10
half_depth = Math.Round(((D / 2) / 10) * 10, 0) 'Get where our first stop is
T = T + Math.Round((((D - half_depth) / 30) / 2) * 2) ' Ascend to first stop at 30ft/min
T = T + (half_depth / 10) ' 1 minute for every stop thereafter
What this does is take a value from Cell B47 on the "Fundies" worksheet and should return a value based on the calculations. I enter =calcAscentTime() into cell B48, expecting to get a value of 8(B47's value is 100), but get a return value of 0. What am I doing wrong?
ou're function isn't returning anything. Assigning the function name to the calculated variable should return the expected result (assuming you have everything else right). Something like:
Public Function calcAscentTime()
IDepth = CInt(Sheets("Fundies").Range("B47"))
T = 0
T = T + 1 ' Add 1 minute for emergency
D = Math.Round((IDepth / 10) * 10) 'Round to Ceiling of nearest 10
half_depth = Math.Round(((D / 2) / 10) * 10, 0) 'Get where our first stop is
T = T + Math.Round((((D - half_depth) / 30) / 2) * 2) ' Ascend to first stop at 30ft/min
T = T + (half_depth / 10) ' 1 minute for every stop thereafter
calcAscentTime = T
End Function
Keep in mind, you should probably Dim your variables to the proper type to avoid any kind of confusion / miss-casting by the compiler.
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
I have currently gotten an algorithm to work for finding the Julian Day for my current location, but when using this value to proceed in finding the Greenwich Mean Sidereal Time, I get some very funky numbers. Can anyone run this script and maybe determine where my calculations go wrong? Thanks.
#1/user/bin/python
import math
from time import gmtime, strftime
#Sidereal Time Program
#Julien Date Converter
seconds = (int(strftime("%S")) * .01)
JD1 = ((367 * (int(strftime("%Y")))) - ((7 * ((int(strftime("%Y")))
+ (((int(strftime("%m"))) + 9) / 12))) / 4)
+ ((275 * (int(strftime("%m")))) / 9) + (int(strftime("%d"))) + 1721013.5
+ ((int(strftime("%I")) + (seconds) + 4) / 24) - 0.5 + 0.5 + 1.46)
JD2 = ((367 * (int(strftime("%Y")))) - ((7 * ((int(strftime("%Y")))
+ (((int(strftime("%m"))) + 9) / 12))) / 4)
+ ((275 * (int(strftime("%m")))) / 9) + (int(strftime("%d"))) + 1721013.5
+ ((int(12) + 4) / 24) - 0.5 + 0.5 - 0.192361555)
H = JD1 - JD2
JD = JD2 + (H / 24)
D1 = JD1 - 2451545.0
D2 = JD2 - 2451545.0
T = D1 / 36525
GMST1 = 6.697374558 + (0.06570982441908 * D2) + (1.00273790935 * H) + (0.000026 * (T * T))
GMST2 = 18.697374558 + (24.06570982441908 * D1)
o = 125.04 - (0.052954 * D1)
L = 280.47 + (0.98565 * D1)
e = 23.4393 - (0.0000004 * D1)
x = 2 * L
sym = (-0.000319 * (math.sin (o))) - (0.000024 * (math.sin (x)))
eqeq = (sym * (math.cos (e)))
GAST1 = GMST1 + eqeq
GAST2 = GMST2 +eqeq
print (JD1)
print (T)
print (GAST1)
print (GAST2)
Edit: Here is the formula I am using: http://aa.usno.navy.mil/faq/docs/GAST.php
It appears that this is a package that will do what you want. See, e.g., here.