counting the number of consecutive days 12-17-09

L

LEG

Hi!
I need help in counting the number of consecutive days of employment for the
same person. (excel funcion or VBA)
F.ex.
A B C D E F
1 John 08-12-2009 John 6 days ended on 13-12-2009
2 John 09-12-2009 4 days enden on 19-12-2009
3 John 10-12-2009 Anders 1
4 John 11-12-2009 8
5 John 12-12-2009 1
6 John 13-12-2009 and so on
7 John 16-12-2009
8 John 17-12-2009
9 John 18-12-2009
10 John 19-12-2009
11 Anders 07-12-2009
12 Anders 09-12-2009
14 Anders 10-12-2009
15 Anders 11-12-2009
16 Anders 12-12-2009
17 Anders 13-12-2009
18 Anders 14-12-2009
19 Anders 15-12-2009
20 Anders 16-12-2009
21 Anders 19-12-2009

I use Excel 2007 and have around 70.000 rows. There are no blanks
I have tried countif, If/then but can't seem to find the solution. Any help
would be greatly appreciated.
 
J

JLatham

If you'd rather have a list rather than using the pivot table, try this code.
What it does: first it sorts your list by date and then again by name, that
will provide a list with the names and dates grouped together so that the
rest of the code can easily work through it and determine the number of
consecutive days a person worked.

To put the code into your workbook: open the workbook, press [Alt]+[F11] to
open the VB Editor, then choose Insert --> Module and copy the code below and
paste it into the module presented to you. Make any edits to the Const
values in the code that you need to. Close the VB Editor and run the code
from Tools --> Macro --> Macros.

Sub FindTermOfService()
'the area on the sheet to receive the results
'will have to be cleared of older results before
'running this macro or the new results will
'just be tacked on to the bottom of the older.
'
'change these as needed for your workbook and
'worksheet setups
Const dataSheetName = "Sheet1"
Const namesInColumn = "A"
Const datesInColumn = "B"
Const firstDataRow = "1" ' perhaps 2 if you have labels
'where to put the names/dates found
Const reportColumn = "D" ' names in D, comment in E

Dim dataSheet As Worksheet
Dim dataRange As Range
Dim anyName As Range
Dim sortKey1 As Range
Dim sortKey2 As Range
Dim lastRow As Long
Dim offset2Date As Long
Dim currentName As String
Dim startDate As Date
Dim currentDate As Date
Dim continuousCount As Long

Application.ScreenUpdating = False ' improve performance
'first sort the entire list by dates
Set dataSheet = Worksheets(dataSheetName)
Set dataRange = dataSheet.Range(namesInColumn & firstDataRow & ":" & _
datesInColumn & _
dataSheet.Range(namesInColumn & Rows.Count).End(xlUp).Row)
Set sortKey1 = dataSheet.Range(datesInColumn & firstDataRow)
Set sortKey2 = dataSheet.Range(namesInColumn & firstDataRow)
'first sort them in ascending order by date
dataRange.Sort Key1:=sortKey1, Order1:=xlAscending, Key2:=sortKey2 _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
'then sort them in ascending order by name
dataRange.Sort Key1:=sortKey2, Order1:=xlAscending, Key2:=sortKey1 _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'now you should have list sorted by name and with dates for each name
'in ascending order also
'a little housecleaning
Set sortKey1 = Nothing
Set sortKey2 = Nothing
'how far from date column to name column?
offset2Date = Range(datesInColumn & 1).Column - _
Range(namesInColumn & 1).Column

'redefine dataRange to only include the names column
'need 1 extra, empty, cell to report things properly
Set dataRange = dataSheet.Range(namesInColumn & firstDataRow & ":" & _
dataSheet.Range(namesInColumn & Rows.Count).End(xlUp).Offset(1, 0).Address)
For Each anyName In dataRange ' look through all names
If anyName <> currentName Then
'starting new person's entry
If currentName <> "" Then
'have old information to report
dataSheet.Range(reportColumn & _
Rows.Count).End(xlUp).Offset(1, 0) = currentName
dataSheet.Range(reportColumn & _
Rows.Count).End(xlUp).Offset(0, 1) = _
continuousCount & " day(s) starting on " & _
Format(startDate, "dd-mmm-yyyy")
End If
currentName = anyName
continuousCount = 1
currentDate = anyName.Offset(0, offset2Date)
startDate = currentDate
Else
'name has not changed, if
'date is current date + 1 day then
'part of continuous, otherwise
'starting new period count
If anyName.Offset(0, offset2Date) = _
currentDate + 1 Then
continuousCount = continuousCount + 1
currentDate = _
anyName.Offset(0, offset2Date)
Else
'starting new series, report the old
dataSheet.Range(reportColumn & _
Rows.Count).End(xlUp).Offset(1, 0) = currentName
dataSheet.Range(reportColumn & _
Rows.Count).End(xlUp).Offset(0, 1) = _
continuousCount & " day(s) starting on " & _
Format(startDate, "dd-mmm-yyyy")
currentDate = anyName.Offset(0, offset2Date)
startDate = currentDate
continuousCount = 1
End If
End If
Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top