Subtotal Date Ranges

Microsoft Office 2007 home and student
March 12, 2010 at 09:11:14
Specs: Windows XP
 Hello,I'm working on an attendance report in Excel, trying to automate a way to count the number of absence occurrences. For example, if an employee is absent on 12/1, 12/2, 12/3, I want Excel to recognize this range as one occurrence. Another issue is weekends. For example, if 12/2 is Friday, and 12/5 is Monday, I need Excel to count 12/2 to 12/5 as one occurrence...any suggestions??Thanks a lot!

See More: Subtotal Date Ranges

#1
March 12, 2010 at 09:17:15
 re: "any suggestions??"Eliminate sick days.Sorry...couldn't resist!I think we need to know how your spreadsheet is laid out before we can offer an suggestions.Could you give us an example of how the dates are in the sheet?

Report •

#2
March 13, 2010 at 11:41:04
 Hi,This macro compares dates stored in a row, for each individual, and determines how many periods of absence have occurred.The number of absence periods is entered in a column immediately to the left of the first date.If the prior day's absence was a Friday, the following Monday is considered to be contiguous and is counted as the same period of absence.This code does not take account of statutory holidays, meaning that a period of absence spanning a statutory holiday will be counted as two periods.The data can have non-date lines in-between. The following shows the test data I used, and in the row underneath each date I used a formula such as =WEEKDAY(C2) to demonstrate how weekends were accounted for. There is no requirement to have weekday information. The code itself tests the dates for Fridays.``` A B C D E F 1 Name Periods Dates 2 Name1 1 18/Feb/10 19/Feb/10 22/Feb/10 23/Feb/10 3 Thu Fri Mon Tue 4 Name2 2 24/Feb/10 26/Feb/10 01/Mar/10 02/Mar/10 5 Wed Fri Mon Tue 6 Name3 4 17/Feb/10 19/Feb/10 24/Feb/10 04/Mar/10 7 Wed Fri Wed Thu ```The location of the first cell containing absence date information (C2 in this example) is hard coded into the macro and can be changed at this line:```'set start cell for date data (start column must be between B & Z) Set rngStart = ActiveSheet.Range("C2")```For simplicity the first column containing dates can only be between B and Z, although the dates can extend as far as necessary - beyond column Z as required.The macro has a test on the first 'date' in each row, so that it can jump rows that do not contain dates. It also tests that any number present is less than Excel's date number a year ago. If you need to process absence dates that are more than 366 days ago, increase the value in this line ```'date test - for dates within last year - increase if necessary intDaysBefore = 366```To run the macro, I suggest you add a button to your source worksheetFrom the Ribbon select Developer (If it's not visible go to the Office Button, select Excel options at the bottom and select the Popular tab and check the 'Show Developer tab in the Ribbon' box)In Developer - Controls select Insert and choose the button icon.Draw the button on the worksheetIn the 'Assign Macro' dialog box select 'New'In the code window that opens enter this:```Option Explicit Private Sub CommandButton1_Click() Dim rngStart As Range Dim rngEnd As Range Dim rngCell As Range Dim rngColStart As Range Dim rngColEnd As Range Dim rngRow As Range Dim strColStart As String Dim intDaysBefore As Integer Dim dblPriorPeriods As Double Dim intPeriods As Integer On Error GoTo ErrHnd 'set start cell for date data (start column must be between B & Z) Set rngStart = ActiveSheet.Range("C2") 'date test - for dates within last year - increase if necessary intDaysBefore = 366 'start column of data strColStart = Chr(rngStart.Column + 64) 'find and set end row of data Set rngEnd = ActiveSheet.Range(strColStart & CStr(Application.Rows.Count)) _ .End(xlUp) 'loop through each row For Each rngRow In Range(rngStart, rngEnd) 'set start of row (first date column) Set rngColStart = ActiveSheet.Range(strColStart & rngRow.Row) 'set end of row (last date entry on row) Set rngColEnd = ActiveSheet.Cells(rngRow.Row, Application.Columns.Count) _ .End(xlToLeft) 'only process row if entry in first data column is a date within the last year 'eliminates 'dates' such as day of week as well as text entries If IsDate(rngRow.Value) And rngRow.Value2 > Date - intDaysBefore Then 'reset periods counter & prior date variable intPeriods = 0 dblPriorPeriods = 0 'loop through each cell in row For Each rngCell In ActiveSheet.Range(rngColStart, rngColEnd) 'if prior date is a Friday then next Monday is 'contiguous' If Weekday(dblPriorPeriods) = vbFriday Then If rngCell.Value2 > dblPriorPeriods + 3 Then intPeriods = intPeriods + 1 End If 'if date is + 1 day from prior date, then it is contiguous ElseIf rngCell.Value2 > dblPriorPeriods + 1 Then intPeriods = intPeriods + 1 End If 'save this date to use as prior date in next comparison dblPriorPeriods = rngCell.Value2 Next rngCell 'row completed - save number of periods in column to left of first date rngRow.Offset(0, -1).Value = intPeriods End If Next rngRow Exit Sub 'error handler ErrHnd: Err.Clear End Sub```Note that Sub Button1_Click() and End sub will already be present, so don't duplicate them. Option explicit goes before Sub Button1_Click().Click Save from the Visual Basic Menu.Alt+f11 takes you back to the main Excel window.Right click the button and Edit the name to something meaningfulAs Macros cannot be undone with the Undo button, test this macro on a copy of your data. Always make a backup of your Workbook before running this macro. This code has only been tested on sample data, and it has not been tested in your environment, so test it on copies of your data to ensure that it works 'as expected'After selecting any cell, the new command button should now respond to a click and run the macro.Regards

Report •
Related Solutions