I have been working on this project for a while and i'm just getting nowhere so I figured i'd ask you guys here. There are a bunch of tasks: Quoting, Binding, Issuance...and they each have their own response times.
Quoting has to be done within 3 hours, while binding is 8 hours and issuance has a 2 day turnaround time. But, the issue is that the response times are based on only a 9:00 - 8:00 pm (est) time, excluding weekends and holidays. I have a holiday lookup table, as well as the task times indexed from another lookup table.
The part that I'm stuck is in regards to "stopping the clock" and having the task response time turn around to next day if it's after 8:00 pm.
This is the formula that I created to do so, but it's not working as it should because it will show the same time if I changed Time to (48,0,0) for issuance or Time(8,0,0) for binding. Column P3 has the start time.
=IF(AND(TEXT(P3,"dddd")="Friday",HOUR(P3)+MINUTE(P3)/60+SECOND(P3)/(60*60)>17),P3+TIME(15,0,0)+DAY(2),IF(HOUR(P3)+MINUTE(P3)/60+SECOND(P3)/(60*60)>17,P3+TIME(15,0,0),P3+Time(3,0,0)))
Thank you! Any help will be greatly appreciated guys!
Here's some untested and not fully implemented code for you to start with:
Function GetTurnaroundDateAndTime(TaskType As String, StartTime As Date, TaskTimeRange As Range, HolidayLookupRange As Range)
Dim taskTime As Double
Dim dayBegin As Double 'could be a parameter
Dim dayEnd As Double 'could be a parameter
Dim result As Date
Dim isValid As Boolean
Dim offset As Double
dayBegin = 9 'could be a parameter
dayEnd = 20 'could be a parameter
offest = 0
'Get Task Time in hours
taskTime = GetTaskTime(TaskType, TaskTimeRange)
'Calculate initial turnaround time (without regard to nights/weekends/holidays)
result = DateAdd("h", taskTime + offset, StartTime)
'check if it's a valid turnaround date and time, return if so
isValid = False
Do While isValid = False
'check #1 - is the turnaround time before the day begins?
If Hour(result) < 9 Then
If Hour(StartTime) < 20 Then
offset = offset - 20 + Hour(StartTime) 'check to see if a portion of the task time would be before end of day, subtract this amount from the offset
End If
offset = offset + 9 = Hour(result) 'gets the offset to the beginning of day
ElseIf Weekday(result, vbSaturday) = 1 Then
offset = offset + 48 'if we're on a Saturday, add two days
ElseIf Weekday(result, vbSunday) = 1 Then
offset = offset + 24 'if we're on a Sunday, add one day
ElseIf IsHoliday(result, HolidayLookupRange) Then
offset = offset + 24 'if we're on a holiday, add one day
Else
isValid = True
End If
result = DateAdd("h", taskTime + offset, StartTime) 're-evaluate result
Loop
GetTurnaroundDateAndTime = result
End Function
Function GetTaskTime(TaskType As String, TaskTimeRange As Range) As Double
'TODO: implement function to lookup the task time from the table
GetTaskTime = 3
End Function
Function IsHoliday(DateToLookup As Date, HolidayLookupRange As Range) As Boolean
'TODO: implement function to lookup if date is a holiday
IsHoliday = False
End Function
Here are some links that should help you get started with VBA:
https://support.office.com/en-us/article/create-custom-functions-in-excel-2f06c10b-3622-40d6-a1b2-b6748ae8231f
https://www.fontstuff.com/vba/vbatut01.htm
You'll want to test a lot of different scenarios before feeling comfortable with the code. I just put something quick together!
Related
Microsoft Excel does not recognise pre-1900 dates and there is plenty of information online which documents this, including the question here.
The best work around (which many other posts link to) seems to be at ExcelUser
However, although the work around gets Excel to recognise a pre-1900 date as a date, it still does not allow it to be used in calculations e.g. when wanting to calculate the number of years since a pre-1900 date.
My question is whether the work around described at ExcelUser can be modified to allow the result to be used in a calculation.
To put things simply, for example, I want to calculate in Excel the number of years since 1/4/1756 - is this possible?
Or does another solution have to be adopted? Perhaps there are plug-ins which address this problem?
First of all I highly recommend to use the ISO 8601 format yyyy-mm-dd for dates because even if you only have strings and no real numeric dates this is properly sortable and the only date format that is defined clearly and cannot be misinterpret like 02/03/2021 where no one can ever say if it is mm/dd/yyyy or dd/mm/yyyy because both actually exist.
Since old dates cannot be real numeric dates but only entered as strings (looking like a date) that means misinterpretation needs to be avioded or you get wrong results. Therefore a date format that cannot be misinterpret is a clear advantage.
Second there is more than one way to calculate "how many years since the birth of Mr. X": For example lets take the birthday of Maryam Mirzakhani 1977-05-12 compared to the date today 2021-04-15. Today she would not have had birthday yet this year and therefore she would be 43 years old. But this year she would have turned 44 years (2021 - 1977 = 44). So the question needs to be asked more precisely. Either "how old would Mr. X be today?" or "how old would Mr. X be this year". The calculation for that would be different.
So let's start and assume the following data. We already know the fact that Excel cannot calculate with dates before 1900. You can see that if we enter pre-1900 dates that they are formatted as string (red dates) and post-1900 dates get formatted as numeric dates (green dates).
Image 1: #WERT! means #VALUE! (sorry for the German screenshot).
Also in column D where the formula =DATEDIF($B2,TODAY(),"y") was used the string dates cannot be calculated with. But since VBA can actually handle pre-1900 dates we can write our own UDF (user defined function) for that. Since as I explained above there is 2 different methods to calculate there is 2 different functions:
OldDateDiff(Date1, Date2, Interval) called like =OldDateDiff($B2,TODAY(),"yyyy")
OldDateAge(Date1, Date2) called like =OldDateAge($B2,TODAY())
Option Explicit
Public Function OldDateDiff(ByVal Date1 As Variant, ByVal Date2 As Variant, ByVal Interval As String) As Long
Dim RetVal As Long 'variable for the value we want to return
Dim localDate1 As Date
If VarType(Date1) = vbDate Or VarType(Date1) = vbDouble Then 'check if Date1 is numeric
localDate1 = CDate(Date1) 'if numeric take it
ElseIf VarType(Date1) = vbString Then 'check if Date1 is a string
localDate1 = ISO8601StringToDate(Date1) 'if it is a string convert it to numeric
Else 'neither string nor numeric throw an error
RetVal = CVErr(xlErrValue)
Exit Function
End If
Dim localDate2 As Date 'same as for Date1 but with Date2
If VarType(Date2) = vbDate Or VarType(Date2) = vbDouble Then
localDate2 = CDate(Date2)
ElseIf VarType(Date2) = vbString Then
localDate2 = ISO8601StringToDate(Date2)
Else
RetVal = CVErr(xlErrValue)
Exit Function
End If
If localDate1 <> 0 And localDate2 <> 0 Then 'make sure both dates were filled with values
RetVal = DateDiff(Interval, localDate1, localDate2) 'calculate the difference between dates with the desired interaval eg yyyy for years
End If
OldDateDiff = RetVal 'return the difference as result of the function
End Function
Public Function OldDateAge(ByVal Date1 As Variant, ByVal Date2 As Variant) As Long
Dim RetVal As Long 'variable for the value we want to return
Dim localDate1 As Date
If VarType(Date1) = vbDate Or VarType(Date1) = vbDouble Then 'check if Date1 is numeric
localDate1 = CDate(Date1) 'if numeric take it
ElseIf VarType(Date1) = vbString Then 'check if Date1 is a string
localDate1 = ISO8601StringToDate(Date1) 'if it is a string convert it to numeric
Else 'neither string nor numeric throw an error
RetVal = CVErr(xlErrValue)
Exit Function
End If
Dim localDate2 As Date 'same as for Date1 but with Date2
If VarType(Date2) = vbDate Or VarType(Date2) = vbDouble Then
localDate2 = CDate(Date2)
ElseIf VarType(Date2) = vbString Then
localDate2 = ISO8601StringToDate(Date2)
Else
RetVal = CVErr(xlErrValue)
Exit Function
End If
If localDate1 <> 0 And localDate2 <> 0 Then 'make sure both dates were filled with values
RetVal = WorksheetFunction.RoundDown((localDate2 - localDate1) / 365, 0)
'subtract date1 from date2 and divide by 365 to get years, then round down to full years to respect the birthday date.
End If
OldDateAge = RetVal 'return the age as result of the function
End Function
' convert yyyy-mm-dd string into numeric date
Private Function ISO8601StringToDate(ByVal ISO8601String As String) As Date
Dim ISO8601Split() As String
ISO8601Split = Split(ISO8601String, "-") 'split input yyyy-mm-dd by dashes into an array with 3 parts
ISO8601StringToDate = DateSerial(ISO8601Split(0), ISO8601Split(1), ISO8601Split(2)) 'DateSerial returns a real numeric date
' ≙yyyy ≙mm ≙dd
End Function
Note that here column B contains 2 different kind of data. Strings (that look like a date) and real numeric dates. If you sort them, all the numeric dates will sort before the string dates (which is probably not what you want). So if you want this to be sortable by birthday column make sure you turn all dates into strings. This can be done by adding an apostrophe ' infront of every date. This will not display but ensure the entered date is considered to be a string.
If your date is in an unambiguous format (eg ISO or a format corresponding to your Windows Regional Settings, or a real date if after 1900), you can use VBA which will recognize early dates.
Function Age(dt As Date)
Age = DateDiff("yyyy", dt, Date)
End Function
You should be aware that, because of how the function calculates years differences, depending on what you want exactly for a result, you may need to adjust the answer if the birthdate is before/after today's date.
In other words, if the day of the year of the birthdate is after the day of the year of Today, you may need to subtract 1 from the result.
But this should get you started.
There's a much easier way than the accepted answer. Simply convert your dates to Unix time:
Function nUnixTime(dTimestamp As Date) As LongLong
' Return given VB date converted to a Unix timestamp.
Const nSecondsPerDay As Long = 86400 ' 24 * 60 * 60
nUnixTime = Int(CDbl(CDate(dTimestamp) - CDate("1/1/1970"))) * nSecondsPerDay
End Function
Unix time is the number of seconds since Jan. 1, 1970, with times before that date being negative. So if you convert your dates to Unix time, you can just subtract them and divide the result by 86,400 to have the difference in days, or by 31,557,600 for years (31,557,600 = 60 * 60 * 24 * 365.25).
Example results of the above VB function called from Excel:
Column A
Column B formula
Column B value
2/2/2022
=nUnixTime(A1)
1,643,760,000
1/1/1970
=nUnixTime(A2)
0
12/14/1901
=nUnixTime(A3)
-2,147,472,000
12/13/1901
=nUnixTime(A4)
-2,147,558,400
1/1/1900
=nUnixTime(A5)
-2,208,988,800
1/1/1800
=nUnixTime(A6)
-5,364,662,400
1/1/100
=nUnixTime(A7)
-59,011,459,200
The reason I included the two dates in 1901 is because their magnitudes in Unix time are just smaller than and just larger than the largest magnitude of a signed 32-bit integer, i.e., a Long in VBA. If the output of the above function were a Long, then values for dates before Dec. 14, 1901 would be the error #Value!. That is the reason the output of the function is defined as LongLong, which is VBA's signed 64-bit integer.
I have a list of voltage outputs and the time stamps at which they were recorded. For some background, my test increments a voltage by 1mV every 30s from 0 - 5V. The system reads every second or so, it can be inconsistent. The sheet has over 70000 rows but I only need just over 5000.
So far I have used =RIGHT(TEXT(A1, "hh:mm:ss"),2) to extract the seconds from the time. Unfortunately, the timestamps are always perfectly every 30s so I can't simply filter for every 0s and 30s. Sometimes 30s is skipped and it reads at say 35s.
How would I create a VBA script that extracts the increments at every 30s interval and if there is no perfect 30s jump, select the closest match to it (i.e. 29 or 31)?
Any guidance would be greatly appreciated!
OK, I think that the following will work. Note that this needs to be entered as an Excel formula array in the Flags output column, with the function's input parameter being the corresponding column that contains the times. (So the output column's formula should look like: {=FlagEvery30Sec(D2:D36)})
' Returns 1 if the corresponding row should be used, and 0 otherwise
Public Function FlagEvery30Sec(SourceTimes As Range) As Integer()
Dim Times() As Variant
Dim Flags() As Long
' get the source values
Times = SourceTimes
' set the output values array to the same size
Dim First As Long, Last As Long
First = LBound(Times, 1)
Last = UBound(Times, 1)
ReDim Flags(First To Last, 1 To 1)
Dim curr As Long, prev As Long
prev = First
curr = First
Flags(curr, 1) = 1
curr = curr + 1
Dim currTime As Date
Dim currSecs As Double, prevSecs As Double, lastFlagSecs As Double
lastFlagSecs = CDbl(Times(curr, 1)) * 24 * 60 * 60
While curr <= Last
Flags(curr, 1) = 0 ' assume not flagged, change later
currSecs = CDbl(Times(curr, 1)) * 24 * 60 * 60
If (currSecs - lastFlagSecs) >= 30 Then
If ((currSecs - lastFlagSecs) - 30) <= (30 - (prevSecs - lastFlagSecs)) Then
Flags(curr, 1) = 1
lastFlagSecs = currSecs
Else
Flags(prev, 1) = 1
lastFlagSecs = prevSecs
End If
End If
prevSecs = currSecs
prev = curr
curr = curr + 1
Wend
FlagEvery30Sec = Flags
End Function
Note that there are basically two approaches to this:
Take the first timestamp, mark off every 30 seconds, then find the entry that is closest to each mark and flag it. Or,
Take the first timestamp and find the following entry that is closest to 30 seconds after it. Then take that entry's time as the base timestamp and find the next entry that is closest to 30 seconds after that. Repeat this until you reach the end.
My function above uses the second method. You should note that this can drift though and the final result may be more or less marks than TotalSeconds/30.
I would like to know how can I go about generating an equal time-space between meetings on worksheet after inputting the "number of meetings", "start time" and "end time" (image shown below). Upon inputting the information into the userform, the "generate" button would then list out all meetings between the indicated "start time" and "end time".
For example, if there are 5 meeting and the start time is 12:00 and end time is 17:00. The generate button would show 5 meetings all space 1 hour apart. 1 meeting would be at 12pm, 1 meeting would be 1pm and so on...
CURRENT CODE
Currently, I am calculating the time difference between Start and End time and calculate the available time for each meetings. How I do not know how to display all 5 meetings where they are equally space apart.
Private Sub generate_btn_Click()
totalHour = DateDiff("n", startTime, endTime) / 60
timePer = num_observation / totalHour
End Sub
The key here is to use TimeValue to parse string with time as proper time and then all calculations become easy:
Sub CalculateHours(numberOfMeetings As String, startTime As String, endTime As String)
startHour = TimeValue(startTime)
endHour = TimeValue(endTime)
differenceTime = endHour - startHour
meetingDuration = differenceTime / numberOfMeetings
For i = 1 To numberOfMeetings
Cells(i, 1) = startHour + meetingDuration * (i - 1)
Next
End Sub
Sub Test()
' Here's how you call it, the parameters will come from your form
Call CalculateHours(5, "12:00", "14:00")
End Sub
And the output is:
I need to trace expire date of materials. To do so, I need to search for specific time interval (e.g. 80 days prior and 40 days later from today).
First, I set today's date in dd/mm/yyyy format. Then, take two input from user such that the first one is to identify the date after today (say x), and the second input for how many days before today (say y).
Now, I need to compare (today + x) and (today - y) dates with expiration date of materials such that whether shelf life of the materials fall within [y,x] interval. However, I am stuck.
I define rear and further as inputBox variables. Value entered to rear would be assigned to the variable x and give "rear" days prior today, and value entered to further would be assigned to variable y and take us "further" days after.
Here I identify today's date ("G1" cell) and time interval with x and y dates as well
Public Sub date()
Dim DateToProcess As Date
DateToProcess = Date
BUBD.Cells.Range("G1") = DateToProcess
rear = InputBox("How many days do you want to trace back?")
x = DateAdd("d", -rear, CDate(Range("G1")))
further = InputBox("How many days after do you want to check?")
y = DateAdd("d", further, CDate(Range("G1")))
End Sub
Then I want to compare materials BUBD with x and y
If rngRisk(j) > x Or rngRisk(j) < y
When I compare x and y with expire dates in rngRisk column, all values are pasted regardless of being in the interval
How can I compare expire dates of materials with x and y?
If I understood correctly your code is not being able to compare dates.
I will assume that rngRisk(j) is a Excel cell, in that case what might be happening is the type of the data in the cell is coming on the wrong format. If the cell is formated as Date, you could do rngRisk(j).Value2. It should returns the date or the number of days since 1900 until the specified date.
OBS: x and y should be date or long type in order to compare dates
in case the cell is in date format
If rngRisk(j).Value2 > x
in case the cell is in text format
If CDate(rngRisk(j).Value2) > x
Edit:
Sample for compare dates
Sub CompareDates()
Dim rngDates As Range
Dim initialDate As Date
Dim finalDate As Date
Dim dateInColumn As Variant
initialDate = Date ' today
finalDate = Date + 3 ' 3 days from now
Set rngDates = ActiveSheet.Range("b2:b21") ' range with dates
For Each dateInColumn In rngDates
If dateInColumn.Value2 > initialDate And dateInColumn.Value2 < finalDate Then
MsgBox CDate(dateInColumn.Value2) & " is in between " & initialDate & " and " & finalDate
End If
Next
End Sub
Welcome!
Firstly, always use Option Explicit on the very top of your code before your Subs.
This will force you to declare your variables which will save you from errors that have to do with data types.
Second, x, y and rngRisk should be declared as date in order to be reliably compared to a date.
Finally, you can just add integers to a variable declared as date like so
dim tomorrow as date
tomorrow = Date + 1
I have written some VBA functions (listed in code below)
I am comparing records from two worksheets using functions to return the related values from one sheet to the other.
The first function, upon which all other functions depend on, returns the Patient ID number.
Criteria to select a Patient ID:
The function compares date and time of patient arrival within a 30
minute interval (since the information recieved from one source
usually varies by a few minutes from the other), gender, clinic ID,
and birthyear. Patient ID numbers start at around 50000, and go on
until around 150000. I need to compare date and time, because from
time to time two patients with the same gender, birthdate and clinic
arrived on the same day.
The function fails after 100000's rows
Beyond this only #VALUE! errors are returned.
Following is a complex scenario I tested, and found the Date and Time to be at fault.
Comparing only Date, with no interval, returns a normal value.
The last Patient ID to work is 98472 (not all Patient IDs have been reported yet), the Patient has an arrival date of May 1st, 2018 at
8:42pm.
The next Patient ID is 100471, arriving on the 4th of May, 2018 at 10:43am. * The function returns this Patient as a #VALUE! error,
although all parameters are there.
Here is the code (pardon any rookie mistakes, I'm no professional coder):
Function EINSATZ(aufnahmdat As Date, geburtsdat As Integer, geschlecht As Integer, klinik As Integer)
'DEFINING PARAMETERS
'rsu_r is the regional stroke unit row
'rsu_c is the regional stroke unit column
'size is the patient list size
'iffunction allows the function to work through the patient list
'converter converts letter to integer for sex
Dim rsu_r As Integer
Dim rsu_c As Integer
Dim size As Variant
Dim iffunction As Single
Dim converter As Integer
'here starts the dimension definition for rsu cells
rsu_r = ActiveCell.Row
rsu_c = ActiveCell.Column
'here starts the size function
'size is predetermined to measure and print the highest value within the first 9996 cells
For iffunction = 4 To 9999
If Application.WorksheetFunction.IsNumber(Worksheets("Präklinik").Cells(iffunction, 5)) Then
size = size + 1
End If
Next iffunction
'here starts the if function
For iffunction = 4 To size
If Worksheets("Präklinik").Cells(iffunction, 6).Value = "m" Then
converter = 2
Else
converter = 1
End If
If Worksheets("Präklinik").Cells(iffunction, 4).Value + Worksheets("Präklinik").Cells(iffunction, 17).Value < aufnahmdat + 1 / 48 _
And Worksheets("Präklinik").Cells(iffunction, 4).Value + Worksheets("Präklinik").Cells(iffunction, 17).Value > aufnahmdat - 1 / 48 _
And Worksheets("Präklinik").Cells(iffunction, 5).Value = geburtsdat _
And converter = geschlecht _
And Worksheets("Präklinik").Cells(iffunction, 41).Value = klinik Then
EINSATZ = Worksheets("Präklinik").Cells(iffunction, 2).Value
Exit For
End If
Next iffunction
End Function
Please help me diagnose the actual cause of error!