Solved: Consecutive Dates

[rynsmns]

Hello All,

My goal is to take a table of employee absences and gather consecutive dates within that table.

I am using Access 2007 which has a UNION query which provides two fields EmployeeID and AbsenceDate. The AbsenceDate field is Date/Time.

Sample Data:
EmployeeID AbsenceDate
uh35355 1/5/2012
uh35355 1/6/2012
mnb8976 1/11/2012
bgj7865 1/24/2012

So in the above example I would like the output to be:

uh35355,1/5/2012,1/6/2012
mnb8976,1/11/2012,1/11/2012
bgj7865,1/24/2012,1/24/2012

I found some VBA code that I have modified to run within my database. I am very new to VBA however and I just can't figure out how to take the code and modify it to where it prints to a table within the database.

Here is the code which runs in the Immediate window of the VBA IDE:

Public Function Consecutive()

Dim db As Database
Dim rs As Recordset
Dim n As Integer
Dim AStartDate As Date
Dim sql As String
Dim MyText As String
Dim MyNum As Integer
Dim intOpenFile As Integer

sql = "SELECT EmployeeID, AbsenceDate " & _
"FROM Employee_Absences_UNION " & _
"ORDER BY EmployeeID, AbsenceDate;"

Set db = CurrentDb
Set rs = db.OpenRecordset(sql)

rs.MoveFirst
Do Until rs.EOF = True
n = 0
AStartDate = rs.Fields("AbsenceDate")

Do Until rs.EOF = True
If rs.Fields("AbsenceDate") = DateAdd("d", n, AStartDate) Then
n = n + 1
rs.MoveNext
Else
Exit Do
End If
Loop

rs.MovePrevious
Debug.Print rs.Fields("EmployeeID") & "," & AStartDate & "," & rs.Fields("AbsenceDate")
rs.MoveNext

Loop

Set db = Nothing
Set rs = Nothing

End Function



Any help would be appreciated!

[rynsmns]

It's clunky but it works and has opened my eyes to what else I can do... :)

Changed the code to open a new recordset and update a table labeled tbltest.

Public Function Consecutive()

Dim db As Database
Dim rs As DAO.Recordset
Dim rst As DAO.Recordset
Dim n As Integer
Dim AStartDate As Date
Dim sql As String
Dim varTextData As String
Dim rtsloop As Recordset

sql = "SELECT EmployeeID, AbsenceDate " & _
"FROM Employee_Absences_UNION " & _
"ORDER BY EmployeeID, AbsenceDate;"

Set db = CurrentDb
Set rs = db.OpenRecordset(sql)
Set rst = db.OpenRecordset("tblTest", dbOpenDynaset)


rs.MoveFirst
Do Until rs.EOF = True
n = 0
AStartDate = rs.Fields("AbsenceDate")

Do Until rs.EOF = True
If rs.Fields("AbsenceDate") = DateAdd("d", n, AStartDate) Then
n = n + 1
rs.MoveNext
Else
Exit Do
End If
Loop

rs.MovePrevious
rst.AddNew
varTextData = rs.Fields("EmployeeID") & "," & AStartDate & "," & rs.Fields("AbsenceDate")
rst!Data = varTextData
rst.Update
rs.MoveNext

Loop

Set db = Nothing
Set rs = Nothing

End Function