Get data based on Months (Name) excel vba - excel

Im currently creating a template for our report. And I would like to do some automation.
I have a source sheet which I call "KPISource" (Data source is in sharepoint, thus this is a table). And in the first column I would like to get data which has has the current Month and the previous month.
Basically, If it is current month, it will then put the data in the "August" column. And If the date is previous month, then it will also put the data in the "July".
In my source sheet, the columns are Date, Tickets Solved (productivity), YTD, Ticket Reopen Rate(quality), Aging <5 days (Quality), YTD (Aging <5 days) Aging > 5 days (Quality), YTD (Aging >5 days), Customer Satisfaction, YTD (Customer Satisfaction)
Currently here is my code, but no output is appearing. This is the code that I'm trying if the there is a previous date in column 1 (KPISource), then it will have the value in KPI.Cells(6, 4).Value (Tickets Solved "July").
Sub OperationalKPI()
Dim KPI As Worksheet
Set KPI = Sheets("OperationalKPI")
Dim KPISource As Worksheet
Set KPISource = Sheets("KPISource")
mPrevious = Format(DateAdd("m", -1, Date), "mmmm")
mCurrent = Format(Date, "mmmm")
lastrow = KPISource.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lastrow
If mPrevious = KPISource.Cells(x, 1) Then
KPI.Cells(6, 4).Value = KPISource.Cells(x, 2).Value
End If
Next x
End Sub

The problem, based upon your feedback, is in the line
If mPrevious = KPISource.Cells(x, 1) Then
mPrevious is a string containing the name of the month, eg "July", however KPISource.Cells(x, 1) contains a date so the two are never going to be equal.
Change the line to:
If mPrevious = Format(KPISource.Cells(x, 1),"mmmm") Then
This will make both items strings with the name of the month in them and the If should find the matches.

Related

how to skip missing dates when looping through a list of dates with do until

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

Finding oldest date in column with separated data

I am making a function that will search through a range and find the oldest date (the oldest date is in last row with data). My range is structured as following and I won't be able to change this structure:
Year Month Day
yyyy mm dd
So the year month and day are seperated in three different columns.
My code is as following:
Function OLDEST(yearrng As Range) As Variant
Dim lastrow As Long
Dim year, month, day As String
lastrow = Range(yearrng).SpecialCells(xlCellTypeBlanks).Row
year = Range("I" & lastrow).value
month = year.Offset(0, 1).value
day = year.Offset(0, 2).value
OLDEST = year & month & day
End Function
The yearrng is the same range which the years are displayed.
The problem is that this function is not working and is returning "value error"...
I hope you understood my question.
Thanks!
For a non-volatile worksheet function, you can try:
=DATE(LOOKUP(2,1/(LEN($I:$I)>0),I:I),LOOKUP(2,1/(LEN($I:$I)>0),J:J),LOOKUP(2,1/(LEN($I:$I)>0),K:K))
where I is the column to test for which is the "bottom" row, and I, J, and K are the columns with the relevant date parts.

Calculating Attendance dates for Students using VBA Excel

I need a little help with resolving a VBA code for an school assignment.
Dim i As Long
Dim LastStudent As Long
Records.Sheets("Student").Activate
LastStudent = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastStudent
If (DateDiff("d", Date, Attendance_rng.Range("I" & i).Value) > 80) Then
.Range("K15").Value = WorksheetFunction.CountIfs(Attendance_rng.Range("A:A"), RollNo, Attendance_rng.Range("D:D"), "ACTIVE")
End If
Next
I tried to execute the above code snippet. I don't see any errors but I don't get any data output either.
I want to count the number of days (Today's date - date in column I for each student), if that value is > 80 then record the day count in cell K15 for each student(Roll Number) from column A where the G Column data is "Active".
Note:
Column I has the Weekly recorded attendance dates

Find number of concurrent, overlapping, date ranges

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

Macro to move data with changing date

Sorry if this isn't explained overly well, im a macro newbie so im not sure if this one is even possible..
I'm looking to create a weekday table for some simple statistic reporting that automatically creates a new row each day, and removes the oldest, showing the data for the current day and 6 days previous. Ideally i'd like the current day at the top of the table, and each day the entered data in the corresponding row moves down 1 row creating space for the new day's stats.
As some background info on what im trying to do.. im basically creating a friendly UI display (offline HTML) of the data recorded in a very simple 5 column (stats) by 7 row (weekdays) table. This database will need to be updated by multiple people with limited technical ability, so im basically trying to make it as easy as possible for them to enter stats each day without having to worry about also updating to correct dates and making sure they are replacing the right days data etc. In theory, it would be great to automate the process of updating the table each day to create space for them to enter the current days data, pushing yesterdays data down one row (and if the cell ranges for the whole table always the same, it should allow me to automate the updates to the offline HTML display as well).
Any ideas?
This should get you started:
Sub WeekdayTable()
Dim tbl As Range
Dim r As Integer
Set tbl = Range("A1:E7") 'Define your table, 5 columns x 7 rows. Modify as needed.
For r = tbl.Rows.Count To 2 Step -1
tbl.Rows(r).Value = tbl.Rows(r - 1).Value
Next
'empty out row 1
tbl.Rows(1).Clear
'Assuming the column 1 contains valid DATE values, _
' we can use the DateAdd function to print the next date:
tbl.Cells(1, 1) = DateAdd("d", 1, tbl.Cells(2, 1))
End Sub
First give a name to the date header cell. (Click the cell. Look at the top left of the screen where the cell coordinates appear. "A1", "B2", etc...
In that textbox, type the header name: "MyDateHeader"
then, use this macro (you can add it to the workbook open event, or activate)
Sub YourMacro()
Dim DateHeader As Range
Set DateHeader = Range("MyDateHeader")
Dim FirstDateCell As Range
Set FirstDateCell = DateHeader.Offset(1, 0)
Dim MyDay As Integer, MyMonth As Integer, MyYear As Integer
Dim CurrDay As Integer, CurrMonth As Integer, CurrYear As Integer
MyDay = Day(FirstDateCell.Value)
MyMonth = Month(FirstDateCell.Value)
MyYear = Year(FirstDateCell.Value)
CurrDay = Day(Date)
CurrMonth = Month(Date)
CurrYear = Year(Date)
If (MyDay <> CurrDay) Or (MyMonth <> CurrMonth) Or (MyYear <> CurrYear) Then
FirstDateCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
DateHeader.Offset(1, 0).Value = Date 'Careful, FirstDateCell has moved down.
DateHeader.Offset(8, 0).EntireRow.Clear
End If
End Sub

Resources