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:
Related
I have data with the following structure:
Date
Time
01-01-2021
0800-1600
01-01-2021
2000-0400
Each line is an employee and their worked hours. Meaning the first line employee #1 meets 0800 and leaves at 1600 the same day. However employee #2 meets 2000 and leaves 0400 the following day.
My issue is that I'm working showing no. of employees present at specific times. The first employee is easy to do as meeting and leaving is the same day. However the second is a bit more problematic, as in my current setup the employee is shown on work the same day.
The data is updated automatically into excel so I don't want to make any manual adjustments.
In order to show it correctly, and from my point of view, I need to make an additional line with the hours for the following day. I could make this with VBA, but I'm not sure if this is the easiest and best way to do it.
So any ideas on how to handle an issue like this?
Thanks!
This formula will give your the hours worked:
=LET(DateValue, A2,
TimeValues,FILTERXML("<t><c>"&SUBSTITUTE(B2,"-","</c><c>")&"</c></t>","//c"),
Start,INDEX(TimeValues,1),
End,INDEX(TimeValues,2),
StartTime, SUM(DateValue, Start/2400),
EndTime, IF(Start<End,SUM(DateValue,End/2400),SUM(DateValue+1,End/2400)),
EndTime - StartTime)
This will give you the hours worked in day one or day two (change the last variable to Day1Hours):
=LET(DateValue, A2,
TimeValues,FILTERXML("<t><c>"&SUBSTITUTE(B2,"-","</c><c>")&"</c></t>","//c"),
Start,INDEX(TimeValues,1),
End,INDEX(TimeValues,2),
StartTime, SUM(DateValue, Start/2400),
EndTime, IF(Start<End,SUM(DateValue,End/2400),SUM(DateValue+1,End/2400)),
Day1Hours, IF(Start<End,EndTime-StartTime,(DateValue+1)-StartTime),
Day2Hours,IF(End<Start, EndTime-(DateValue+1),0),
Day2Hours)
This I was hoping would return both results, but FILTERXML didn't seem to work within the LET function when returning the results:
=LET(DateValue, A2,
TimeValues,FILTERXML("<t><c>"&SUBSTITUTE(B2,"-","</c><c>")&"</c></t>","//c"),
Start,INDEX(TimeValues,1),
End,INDEX(TimeValues,2),
StartTime, SUM(DateValue, Start/2400),
EndTime, IF(Start<End,SUM(DateValue,End/2400),SUM(DateValue+1,End/2400)),
Day1Hours, IF(Start<End,EndTime-StartTime,(DateValue+1)-StartTime),
Day2Hours,IF(End<Start, DateValue+1-EndTime,0),
TRANSPOSE(FILTERXML("<t><c>" & Day1Hours & "</c><c>" & Day2Hours & "</c></t>","//c")))
Create a User Defined Function (UDF) to return a datetime in cols C and D from the values in col A and B. Put the UDF code in a module. For example the formula in C2 would be =date_time($A2,$B2,0) and in D2 =date_time($A2,$B2,1)
Option Explicit
' i=0 for start , i=1 for end
Function date_time(dt As Date, hrs As String, i As Integer) As Date
Dim ar
ar = Split(hrs, "-")
If ar(1) < ar(0) Then ar(1) = ar(1) + 2400 ' next day
' add minutes
date_time = DateAdd("n", Left(ar(i), 2) * 60 + Right(ar(i), 2), dt)
End Function
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!
I'm trying to create a work schedule that adjusts the start and end date of a task (in this case a 'lesson') based on whether it is a weekday and/or a weekend. I have assigned a value in terms of complete days to each 'lesson', based on the day of the week. My hope is that if a lesson takes 2 days to complete during the week, and the range 'start.date:start.date + 2' doesn't contain a weekend day, then the end date would be 'start.date + 2' (e.g. Monday + 2). Equally, if that same lesson would take 1 day to complete on the weekend, and the range 'start.date:start.date + 1' doesn't contain a weekday, then the end date would be 'start.date + 1' (e.g. Saturday + 1).
However, the tricky part is when that range contains a mix of weekday and weekend. In that situation I'd like it to switch between the two lengths. For example, if all lessons take 2 days during the week and 1 day on the weekend, if:
start.date(1) = beginning of Friday, end.date(1) = halfway through Saturday (1 weekday + 0.5 weekend).
start.date(2) = halfway through Saturday, end.date(2) = halfway through Sunday.
start.date(3) = halfway through Sunday, end.date(3) = end of Monday (0.5 weekend + 1 weekday).
I've attached a spreadsheet along with images showing the formulas that I currently have. It works OK until the end date in cell H11. It should read Tuesday (as J11 should = 1, and K11 should = 0.5)
https://1drv.ms/x/s!ApoCMYBhswHzhttuLQmKNVw7G6pHSw
If this would be better suited to Python or R, or even VBA, then I'm more than happy to hear suggestions for those (also including relevant things to read so that I can start writing the necessary code), but I just don't have the required knowledge in them to make a decent start at the moment.
Thanks for your help.
You have to insert this macro into your workbook, I have mentioned the steps but if you find it difficult you can let me know.
Click Alt+F11 in your excel window
The VBA editor will open in a new window, in this window there is a
left side pane named as project window
Right click this workbook in project window and insert module.
Paste the below code on the newly opened text editor
.
Function calcEndDate(start_date, weekday_duration, weekend_duration)
ratio = weekday_duration / weekend_duration
temp_date = start_date
day_name = ""
For i = 1 To weekday_duration
day_name = Format(temp_date, "dddd")
If (day_name = "Saturday" Or day_name = "Sunday") Then
temp_date = temp_date + 1 / ratio
Else
temp_date = temp_date + 1
End If
Next
calcEndDate = temp_date
End Function
Now paste this formula in any cell, it will calculate the end date using start date and the duration
calcEndDate(start_date, weekday_duration, weekend_duration)
After that you have to save your workbook in xlsm (macro enabled excel workbook) format
For example for your first row it would be =calcEndDate(F3,B3,C3)
Then change the format of that column to mm/dd/yyyy hh:mm, so that you can know if a lesson is ending in half day.
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!
I am trying to create a spreadsheet into which will be entered a number of events, such as communications sent. I would like to create a userform into which a user can enter 1. the Date of the event 2. the time (in EST) at which the event occurred 2. the equivalent UTC time for that event 3. the equivalent Tokyo time for that event.
A date is always available to be entered, but you never know if the time stamp for a given event is going to be an EST, UTC or Tokyo time stamp. I would like it so that the three texboxes for UTC, EST or Tokyo are automatically populated if any one of them has a time value. So for example if time stamp is entered in the EST box, VBA will add 4 hours and populate the UTC box and add another 12 or whatever to populate the Tokyo box.
To start with, I wrote the following code for the Date textbox in the userform:
Public Sub dtefrm_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim dte
Dim dstdte As Boolean
Let dte = CDate(Me.dtefrm.Value)
Select Case True
Case dte > CDate("3/9/2008") And dte < CDate("11/2/2008")
dstdte = True
Me.dayconf.Value = "Daylight Savings"
End Select
End Sub
Now, I would like to attach code to the EST text box so that when time is entered into it, the UTC text box is populated with that time + 4 if the Date is between 3/1/2008 and 11/1/2008, and + 5 if it is not.
This is what I came up with:
Public Sub estfrm_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
varest = Application.WorksheetFunction.Text(Me.estfrm.Value, "hh:mm:ss")
Me.estfrm.Value = varest
Let dte = CDate(Me.dtefrm.Value)
Select Case True
Case dte > CDate("3/9/2008") And dte < CDate("11/2/2008")
dstdte = True
End Select
If dstdte = True Then
Me.utcfrm.Value = CDate(Me.utcfrm.Value) + 4
End If
End Sub
I think I was having trouble using the dstdte Boolean value in the EST box code, I tried to make both the subs public that didn't help so I copied the select case code from the first sub to the second, but still no luck. Right now I'm getting Error thirteen. I tried 4/24 instead of 4, same issue.
for reference, dtefrm is the name of the text box into which the user enters the date, dayconf is a textbox on the form that just says Daylight savings if the date matches and estfrm is the name of the box into which EST time is entered and utcfrm is the name of the UTC box.
Do a function you can call from both:
Function IsDts(ByVal cellValueDate as Date)
Select Case True
Case cellValueDate > CDate("3/9/2008") And cellValueDate < CDate("11/2/2008")
IsDts = True
Case Else
IsDts = False
End Select
End Function
And call this in your other events like estfrm_BeforeUpdate
isValDst = IsDts(CDate(Me.dtefrm.Value))