I have a puzzle I've been trying to solve for ages now, but it's quite simply beyond me.
I have a spreadsheet with 3 columns. Column A is instructor ID numbers, Column B is their course Start date and Column C is their course end date. There are multiple courses for each instructor ID.
I'm basically trying to answer the question, what is the maximum number of courses this instructor is teaching at any given time.
Essentially, I need to find, for each ID number, the number of maximum, concurrent, overlapping date ranges.
The trouble is, while I know how to find overlapping date ranges, I don't know how to count the number of concurrent courses.
Eg.
Instructor 115 has the following date ranges listed:
9/10/13 / 11/04/13
9/17/13 / 11/11/13
11/05/13 / 12/30/13
11/12/13 / 1/20/14
While the 11/05/13 course overlaps with both the 9/17/13 course and the 11/12/13 course, they do not overlap with each other... so this instructor is only teaching a maximum of 2 courses at any time.
Is there a way to write a function that will return the highest number of concurrent overlapping date ranges for each ID?
Edit not form OP to transfer details from a comment:
I can solve this geometrically, but I don't know how to do that in a VBA function (I'm still very new to programming). If I were to solve this outside of code, I would create a table for each ID making a column for every day. I'd then create a row for each date range, marking a 1 in each column that range overlaps with. then I’d sum the total overlaps for each day. Then I’d use a simple MAX function to return the highest number of consecutive overlaps. Is there a way to do this inside of a function without having Excel physically draw out these tables?
Using VBA, assuming Column A contains your start dates, and column B contains your end dates, and assuming your data starts in row 1 and there are no blank rows in your data, the below sub will do what you outlined in your comment:
Sub getMaxConcurrent()
'get minimum date (startDate)
Dim startDateRange
Set startDateRange = Range("A1", Range("A1").End(xlDown))
Dim startDate As Date
startDate = WorksheetFunction.Min(startDateRange)
'get maximum date (endDate)
Dim endDateRange
Set endDateRange = Range("B1", Range("B1").End(xlDown))
Dim endDate As Date
endDate = WorksheetFunction.Max(endDateRange)
'get date range (dateInterval)
Dim dateInterval As Integer
dateInterval = DateDiff("d", startDate, endDate)
'Create daily table header
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Dim x As Integer
For x = 0 To dateInterval
Dim dateVal As Date
dateVal = DateAdd("d", startDate, x)
Cells(1, 3 + x).Value = dateVal
Next
'Fill in daily table
Dim y As Integer
y = 2
Dim startDateValue As Date
startDateValue = Cells(y, 1).Value
Do Until IsEmpty(Cells(y, 1).Value)
For x = 3 To dateInterval + 3
If (Cells(y, 1).Value <= Cells(1, x).Value) Then
If (Cells(y, 2).Value >= Cells(1, x).Value) Then
Cells(y, x).Value = 1
Else
Cells(y, x).Value = 0
End If
Else
Cells(y, x).Value = 0
End If
Next
y = y + 1
Loop
'sum up each day
For x = 3 To dateInterval + 3
Cells(y, x).Value = WorksheetFunction.Sum(Range(Cells(2, x).Address & ":" & Cells(y - 1, x).Address))
Next
MsgBox ("Max concurrent courses: " & WorksheetFunction.Max(Range(Cells(y, 3).Address & ":" & Cells(y, x).Address)))
End Sub
If you have data down to row 1000 then this "array formula" will give the maximum number of concurrent courses for an Instructor ID in E2
=MAX(COUNTIFS(A:A,E2,B:B,"<="&B$2:C$1000,C:C,">="&B$2:C$1000))
confirmed with CTRL+SHIFT+ENTER
Let's assume there is only one instructor and you have start and end dates in A1:B4.
Copy A1:A4 to A7:A10, copy B1:b4 to A11:a14 (right under it). Select A7:A14, hit Sort (on data tab) and "remove duplicates". You have a list unique list of dates in ascending order. Let's assume there were no duplicates (as in your example), your of date is same A7:a14. Select it copy, and paste spacial with transpose to C5.
At this point You have start and end dates in A1:B4 and list of uniqe dates in C5:J5. Put formula =IF(AND($A1<=C$5,C$5<=$B1),1,0) in C1 and copy it to C1:J4.
put formula =SUM(C1:C4) in C6 and copy it to C6:J6.
Maximum number in C6:j6 is your maximum concurrent courses for this instructor
Related
I have a for loop that iterates through each sheet in my workbook. Each sheet is identical for most purposes. I am making an overview sheet in my workbook to express the results from the data in the other sheets(the ones that are identical).
There are 11 vehicles, each with their own sheet that has data from a test from each day. On any given day there can be no tests, or all the way to 30,000 tests. The header of each column in row 47 states the date in a "06/01/2021 ... 06/30/2021" format. The data from each iteration of the test will be pasted in the column of the correct date starting at row 49.
So what my overview page needs to display is the data from the previous day. In one cell on my overview there is a formula for obtaining just the number of the day of the month like 20 or 1 etc. Using this number, the number of the day is the same as the column index that the previous day's data will be in conveniently. So in my for loop I want to have a table that has the name of each sheet in column B, in column C I want to display the total number of tests done in that day(not the sum of all the data), in column D I need the number of tests with a result of 0, in column E I need the number of tests that have a result above the upper tolerance, and in column F I need the number of tests that have a result below the lower tolerance minus the result in column D.
I've been playing with the Application.WorksheetFunction.Count and CountIf functions but I keep getting 0 for every single cell. I made two arrays for the upper and lower tolerance values which are type Longs called UTol and LTol respectively. TabList is a public array that has each of the sheet names for the vehicles stored as strings. finddate is an integer that reads in Today's day number which is yesterday's column index. I've included a picture of the table in question and my for loop code:
finddate = Worksheets("Overview").Range("A18").Value
For TabNRow = 1 To 11
startcol = 3
Worksheets(TabList(TabNRow)).Activate
Debug.Print (TabList(TabNRow))
'Total number of tests done that day
Worksheets("Overview").Cells(startrow, startcol).Value = Application.WorksheetFunction.Count(Range(Cells(49, finddate), Cells(30000, finddate)))
startcol = 4
'Total number of 0 results, this used to get the number of 0's from each sheet but that row has since been deleted
Worksheets("Overview").Cells(startrow, startcol).Value = Worksheets(TabList(TabNRow)).Cells(48, finddate).Value
startcol = 5
'Total number of results above tolerance
Worksheets("Overview").Cells(startrow, startcol).Value = Application.WorksheetFunction.CountIf(Range(Cells(49, finddate), Cells(30000, finddate)), ">" & UTol(TabNRow))
startcol = 6
'Total number of results below tolerance
Worksheets("Overview").Cells(startrow, startcol).Value = Application.WorksheetFunction.CountIf(Range(Cells(49, finddate), Cells(30000, finddate)), "<" & LTol(TabNRow))
startrow = startrow + 1
Next TabNRow
```
No need to select/activate sheets when referencing them. See: How to avoid using Select in Excel VBA
Something like this should work:
Dim wsOv As Worksheet, wsData As Worksheet, rngData As Range
Set wsOv = ThisWorkbook.Worksheets("Overview")
finddate = wsOv.Range("A18").Value
For TabNRow = 1 To 11
Set wsData = ThisWorkbook.Worksheets(TabList(TabNRow))
Set rngData = wsData.Range(wsData.Cells(49, finddate), _
wsData.Cells(Rows.Count, finddate).End(xlUp))
Debug.Print wsData.Name, rngData.Address 'edited
With wsOv.Rows(2 + TabNRow)
.Columns("C").Value = Application.Count(rngData)
.Columns("D").Value = Application.CountIf(rngData, 0)
.Columns("E").Value = Application.CountIf(rngData, ">" & UTol(TabNRow))
.Columns("F").Value = Application.CountIf(rngData, "<" & LTol(TabNRow)) _
- .Columns("D").Value
End With
Next TabNRow
I am writing a VBA code in my excel. I have employees date of birth on Row F. Now, using VBA, I want phrase called "Happy Birthday" on column G for those employees who have birthdays. My table starts from row 6 to row 50. I wrote the following code but it always gives error in Month(Range("f" & y)). The month function gives me error. If, for example, I only write Range("f" & y), it will work fine. This means the Date of birth on column F isn't being recognized as DATE in my VBA (they are in date format in excel). There is a mismatch for sure. Can someone please help me how to fix this issue (using for next function as shown below)?>
Sheets("Employees").Select
For y = 6 To 50
If Month(VBA.Date) = Month(Range("f" & y)) Then
Range("g" & y).Value = "HBD"
Else
Range("g" & y).Value = "No hbd"
End If
Next y
Note: A). I am looking at the month of date of birth only for wishing happy birthday and I am not looking at day. B). I want message called HBD or NO HBD to be posted on column G for each employee based on their DOB given on Column F .
With a formula I think you should be able to do it with =IF(MONTH(TODAY())=MONTH(F6),"HBD","No HBD").
For a VBA solution use:
Sub Test()
Dim y As Long
With ThisWorkbook.Worksheets("Employees")
For y = 6 To .Cells(.Rows.Count, 6).End(xlUp).Row
If Month(Date) = Month(.Cells(y, 6)) Then
.Cells(y, 7) = "HBD"
Else
.Cells(y, 7) = "No HBD"
End If
Next y
End With
End Sub
NB: Cells(Row, Column) is used in place of Range - easier for referencing a single cell using row/column numbers.
I have a data dump in Excel that consists of monthly crew member hours worked data. Currently, there are multiple rows of data for the same date.
I want to run a macro that keeps unique names and unique dates but delete rows that have duplicated dates (keep one row for each crew member per date). In the "hours" column, I wish to combine multiple shifts from the same day into one.
Here is my code so far and result.
Sub mcrCombineAndScrubDups()
For Each a In Range("A1", Cells(Rows.Count, "A").End(xlUp))
For r = 1 To Cells(Rows.Count, "A").End(xlUp).Row - a.Row
If a = a.Offset(r, 0) And a.Offset(0, 1) = a.Offset(r, 1) And a.Offset(0, 2) = a.Offset(r, 2) Then
a.Offset(0, 6) = a.Offset(0, 6) + a.Offset(r, 6)
a.Offset(r, 0).EntireRow.Delete
r = r - 1
End If
Next r
Next a
End Sub
With the current code, it combines all the hours worked for the entire month into one field rather than a row for each crew member for each date. I know a pivot table can be run but my boss wants more automatic. Thanks!
I have a production plan that lists models to be produced (column A), production quantity (column B) and production dates (column C). Based on these I calculate ETA dates (column D) for semi-knockdown units (column E) that will be turned into finished models. Each day a varying number of different models are produced, but as long as the original production date is the same, the ETA date (and eventually the PO number) for all semi-knockdowns needed on that particular day will also be the same.
As a next step I want to automatically attach a running PO number (counter in cell J1) to each order for semi-knockdown units - same production date, same PO number. Once the production date changes, the PO number counter is updated +1.
Upon execution my code first checks for the first fresh line in column G, and then asks how many POs to create. Everything works, except for the fact that weekend-/holiday-/ etc dates, which are not listed in the production plan, also update the running PO. In addition, for each missing production date one of the PO cycles is unnecessarily "lost".
The problem seems to be that PO and active date are both updated at the end of my loop, regardless of the date actually being listed.
I tried to fix this by adding a second condition to the IF clause, after adding missing dates and a qualifier ("no prod") to the original production plan, but the code would only run until the first no prod -day. I would also prefer not to add missing dates to the production plan, as it adds another preliminary step to the process.
Another solution might be to only add working days to the initial date when cycles are initially set. That would make sure that no cycles are lost on non-existent dates, but I think the PO counter would still update for missing dates as well.
Sub create_PO_021()
'adds the running PO number
'running count of purchase orders
Dim PO As Integer
PO = Range("J1").Value
'counts total used lines based on SKU#
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
'searches for first open cell in PO column
Dim rw As Integer
rw = Range("G" & Rows.Count).End(xlUp).Row + 1
'define first production date for which to create a PO
Dim firstDate As Date
'firstDate = Application.InputBox("On what production date do you want to start:", "Enter date")
firstDate = Cells(rw, 3).Value
MsgBox "Starting at production date" & " " & (firstDate)
'define how many POs you want to create
'count from start date to first gap (week-end or similar)
Dim POcycles As Integer
POcycles = Application.InputBox("How many orders do you want to do?", "Enter number")
'calculate last production date for which to create a PO
Dim lastDate As Date
lastDate = firstDate + POcycles
Dim activeDate As Date
activeDate = firstDate
Do Until activeDate = lastDate
For a = 1 To lastRow
If Cells(rw, 3).Value = activeDate Then
Cells(rw, 7).Value = PO + 1
Cells(1, 10).Value = PO + 1
rw = rw + 1
End If
Next a
PO = PO + 1
activeDate = activeDate + 1
Loop
End Sub
The present result for initial PO = 100, and 5 POs to create:
wrong result
The desired result with the same parameters:
desired result
I am trying to model the cost of my home heating unit. I have 3.15 years of hourly data. I calculated cost per hour, cost per day, cost per month, and cost per year. I want to write two VBA function, one called CostPerDay and the other called CostPerMonth in order to simplify the process when I add more data. I have attached a picture of my data.
Picture of Data
The function I wrote for Cost Per Day is:
=SUM(OFFSET($M$18,(ROW()-18)*24,0,24,1))
The function I wrote for Cost Per Month is:
Jan-13 =SUM(OFFSET($P$18,(ROW()-18)*31,0,31,1))
Feb-13 =SUM(OFFSET($P$49,(ROW()-19)*28,0,28,1))
Mar-13 =SUM(OFFSET($P$77,(ROW()-20)*31,0,31,1))
Etc...
In case you need the whole range of data:
Cost Per Hour - M18:M27636
Cost Per Day - P18:P1168
Cost Per Month - S18:S55
Average Cost Per Month - V18:V29
This is what I was trying. As you can see, I am new to VBA. In the first attempt, I was trying to use Dim to define where the data was located in the spreadsheet and which cell I wanted the calculation in. I got stuck because I couldn't insert the =SUM(OFFSET($M$18,(ROW()-18)*24,0,24,1))function into VBA. I then was trying to make get rid of the hard-coded $M$18by replacing it with Cells(Match(Day,O18:O1168)+17,"P"). But none of it worked.
The second one I was playing with dialogue boxes, but I don't think I want to use them.
In the third attempt I was trying to calculate Cost Per Month. I don't have it because I didn't save it. I was using SUMIFSto match Months with the number of days in the month. That may have been my closest attempt but it still didn't work.
Function CostPerDay(BeginningCostPerDay, OutputCell)
Dim BeginningCostPerDay, OutputCell
BeginningCostPerDay = WorksheetFunction.DSum()
OutputCell = ActiveCell.Offset(3, -3).Activate
End Function
Function CostPerDay1()
Dim myValue1 As Variant, myValue2 As Variant
myValue1 = InputBox("Where do you want the data put?")
myValue2 = InputBox("What is the beginning Cost Per Day")
Range("myValue1").Value = myValue1
Range("myValue2").Value = myValue2
End Function
What if you added a helper column that started with 1 in cell A1 for example. Second row (A2) would be =If(A1=24,1,A1+1). Column B would have the hourly data. Column C or C1 would say =If(and(A1=24,A2=1),B1,B1+B2)). I didn't test, but I think this should work with perhaps a tweak.
Here's your answer.
Private Sub SumCosts(ByVal MainColumn As String, ByVal CostColumn As String, ByVal FirstDataRow As Long, Optional ByVal BracketType As Byte)
'
'Parameters:
'MainColumn: the columns with dates or months.
'CostColumn: the column that holds the costs to sum.
'FirstDataRow: the first row where the data starts
'BracketType: either 0 for hours or 1 for months
'
'This procedure assumes that in the data on the sheet
'- every hour of every day in the hours columns
'- every day of a month is present in the days columns
'are present. I.e. All hours of all 31 days of January are persent
'in the 'Date' column before the hours of February start and all days of January
'are present in the 'Month' column before the days of February start.
Const Hours As Byte = 24
'
Dim Cel As Range
Dim I As Long
Dim J As Long
Dim K As Long
Dim Rng As String
Dim Bracket As Byte
Dim Days As Byte
'
'Clean the target area, so the modle can be reused time after time.
Set Cel = Range(MainColumn & Application.Rows.Count).Offset(0, 1)
Rng = Split(Cel.Address, "$")(1)
Rng = (Rng & FirstDataRow & ":" & Rng & Cel.End(xlUp).Row)
Range(Rng).ClearContents
'
J = FirstDataRow
For Each Cel In Range(MainColumn & ":" & MainColumn)
If Cel.Value = vbNullString Then Exit For
If Cel.Row > (FirstDataRow - 1) Then
'Number of days in a month. Since this fluctuates the bracket fluctuates.
Days = DateSerial(Year(Cel.Value), Month(Cel.Value) + 1, 1) - DateSerial(Year(Cel.Value), Month(Cel.Value), 1)
Bracket = IIf(BracketType = 0, Hours, Days) 'Select the bracket to use.
K = ((Cel.Row - 1) * Bracket) + (FirstDataRow - 1) 'Determine where to stop calculating for a given day or month.
For I = J To K
Cel.Offset(0, 1).Value = Cel.Offset(0, 1).Value + Range(CostColumn & I).Value 'Do the calculation.
Next
J = K + 1 'Next loop we must pick up where we left off.
End If
Next
End Sub
Public Sub LaunchCostCalculations()
SumCosts "O", "M", 2, 0
SumCosts "R", "P", 2, 1
End Sub
Create a button in your sheet to launch LaunchCostCalculations and Bob's your uncle.