Subtotal Date Ranges

Microsoft Office 2007 home and student
March 12, 2010 at 09:11:14
Specs: Windows XP

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

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 •

March 13, 2010 at 11:41:04

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 worksheet
From 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 worksheet
In 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)) _

'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) _
    '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
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 meaningful

As 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.


Report •
Related Solutions

Ask Question