Determine sequential dates

[noxidba]

Hello, I am needing to loop through records of employees with time take off dates and determine how many days off have been taken off in a row. For example, jDoe has dates 09/01/2016, 09/02/2016, 09/03/2016, 09/05/2016. I need to know that 3 days were taken off in a row. Below is the code and I am not sure how to change to account for the sequential days. Any help is appreciated.

Dim DB As Database
Dim rst As Recordset
Dim strsql As String
Dim EmplID_1 As String * 7, EmplID_2 As String * 7
Dim Dte_1 As Date, Dte_2 As Date
Dim count As Integer

Set DB = CurrentDb

strsql = "Select * from [Q316tbl-MonthThreeTimeOffFile] Order by [ID], [DateTaken];"

Set rst = DB.OpenRecordset(strsql, dbOpenDynaset)
count = 1
EmplID_1 = rst.Fields("ID").Value
Dte_1 = rst.Fields("DateTaken").Value
rst.Edit
rst.Fields("seq").Value = count
rst.Update
While Not (rst.EOF)
rst.MoveNext
EmplID_2 = rst.Fields("ID").Value
If ((EmplID_1 = EmplID_2) And (Dte_1 <> Dte_2)) Then count = count + 1 Else count = 1
rst.Edit
rst.Fields("Seq").Value = count
rst.Update
EmplID_1 = EmplID_2
Wend

 

[MajP]

Looks pretty close just need to check if the new date is + 1 greater than the current date. Also was not sure how you handle off Friday and Monday. Could be considered sequential in some businesses. I gave code for both.

One thing all dates can have both a date and time component, even if it is not formatted to display the time. So you may need to take the integer portion of the date to ensure you strip off any time component.

Public Sub UpdateSequential()
  Dim rs As DAO.Recordset
  Dim CurrentEmployeeID As Long
  Dim NewEmployeeID As Long
  Dim CurrentDate As Date
  Dim NewDate As Date
  Dim strSql As String
  Dim sequenceCounter As Integer
  strSql = "SELECT EmployeeID, DateOff, OffSeq From tblTimeItems ORDER BY EmployeeID, DateOff"
  Debug.Print strSql
  Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
  
  CurrentEmployeeID = rs.Fields("EmployeeID")
  CurrentDate = Int(rs.Fields("DateOff"))
  sequenceCounter = 1
  
  Do While Not rs.EOF
    NewEmployeeID = rs.Fields("EmployeeID")
    NewDate = Int(rs.Fields("DateOff"))
    'Uncomment the Correct choice if Friday and Monday are considered continous
    'If NewEmployeeID = CurrentEmployeeID And NewDate = CurrentDate + 1 Then
    'If NewEmployeeID = CurrentEmployeeID And (NewDate = CurrentDate + 1 Or (Weekday(CurrentDate) = vbFriday And NewDate = CurrentDate + 3)) Then
         sequenceCounter = sequenceCounter + 1
    Else
       sequenceCounter = 1
    End If
      CurrentEmployeeID = NewEmployeeID
      CurrentDate = NewDate
      rs.Edit
        rs.Fields("offseq").Value = sequenceCounter
      rs.update
   rs.MoveNext
 Loop
End Sub

 

[MajP]

Here is a much better approach, because you can answer a lot more questions. Instead of numbering the sequence, give every sequence a unique ID. Then you can easily show all start, stop, and length of sequences.

Public Sub ID_Sequences()
  'Provide a unique ID to each sequence
  Dim rs As DAO.Recordset
  Dim CurrentEmployeeID As Long
  Dim NewEmployeeID As Long
  Dim CurrentDate As Date
  Dim NewDate As Date
  Dim strSql As String
  Dim SequenceID As Integer
  strSql = "SELECT EmployeeID, DateOff, SequenceID From tblTimeItems ORDER BY EmployeeID, DateOff"
  Debug.Print strSql
  Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
  
  CurrentEmployeeID = rs.Fields("EmployeeID")
  CurrentDate = Int(rs.Fields("DateOff"))
    
  Do While Not rs.EOF
    NewEmployeeID = rs.Fields("EmployeeID")
    NewDate = Int(rs.Fields("DateOff"))
    'Uncomment the Correct choice if Friday and Monday are considered continous
    If Not (NewEmployeeID = CurrentEmployeeID And NewDate = CurrentDate + 1) Then
    ' If Not (NewEmployeeID = CurrentEmployeeID And (NewDate = CurrentDate + 1 Or (Weekday(CurrentDate) = vbFriday And NewDate = CurrentDate + 3))) Then
         SequenceID = SequenceID + 1
    End If
      CurrentEmployeeID = NewEmployeeID
      CurrentDate = NewDate
      rs.Edit
        rs.Fields("SequenceID").Value = SequenceID
      rs.update
   rs.MoveNext
 Loop
End Sub

Then you can do a query like this

SELECT 
   EmployeeID, 
   Min(DateOff) AS StartSequence, 
  Max(DateOff) AS EndSequence, 
  Count(SequenceID) AS SequenceLength, 
  SequenceID
FROM 
  tblTimeItems
GROUP BY 
  EmployeeID, 
  SequenceID
HAVING 
  Count(tblTimeItems.SequenceID)>1

 

[noxidba]

Thanks after a little tweaking that worked. The other issue I have is to account for holidays and not include in the count of days taken. For example if someone took off 9/2, 9/6, 9/7, 9/8, 9/9. Since 9/5 is a holiday they were really off 5 work days.

 

[MajP]

The best way to do holidays is to make a table of holidays for several years. This is more accurate and easier than trying to calculate all of the holidays. The you can check each date using a dlookup to see if it is a holiday.

Not sure of the rule though.
If they were off 9/4, 9/5, 9/6, 9/7 and 9/5 is a holiday what do you want to do with the sequence. Is is still a three day sequence 9/4, 9/6, 9/7 just like a Thursday, Friday and Monday? Of is it two sequences (9/4) and (9/6 and 9/7)

 

[noxidba]

I would need to count the days as one set of days taken off and exclude the holiday. See examples below.
Example1:
Friday holiday before taken
9/2 = 1
9/5 = 0
9/6 = 2
9/7 = 3
9/8 = 4
9/9 = 5

Example2:
no previous day taken
9/5 = 0
9/6 = 1
9/7 = 2
9/8 = 3
9/9 = 4
no additional days taken

Example3:
no previous day taken
9/5 = 0
9/6 = 1
9/7 = 2
9/8 = 3
9/9 = 4
9/12 = 5
Monday the following week taken