INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
• Keyword Search
Favorite Forums
• Automated Signatures
• Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

#### Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

# Group by ID and determine consecutive dates

## Group by ID and determine consecutive dates

(OP)
So I have researched this forum and the innerwebs trying to find some similar solution that I could outfit to work for my needs. Since I am posting here I have not succeeded in finding the solution so I appreciate your time to help me out.

Here is what I am looking to do via VBA and future one button execution.

Sample Data:
ID Dte
11009 1/9/2017
11009 3/21/2017
119957 2/21/2017
226715 1/15/2017
226715 3/5/2017
226715 3/13/2017
226715 3/14/2017
239416 2/3/2017
239416 2/6/2017
239416 2/7/2017
239416 2/8/2017
239416 2/15/2017
239416 2/16/2017
239416 3/8/2017
239416 3/30/2017
239416 4/3/2017
239416 4/4/2017
239416 4/5/2017
239416 4/6/2017
239416 4/13/2017
273887 3/14/2017
273887 4/11/2017
273887 4/12/2017
394892 2/20/2017

What I am trying to do is read through the records and determine at what point there are 2 consecutive dates per ID. For example when reading the list you will see that ID 226715 has 4 entries and only 2 of them are consecutive. The ultimate goal is to determine just the first 2 consecutive dates. So in example of 239416 there are dates 4/3, 4/4, 4/5, 4/6. Although there are 4 dates consecutively I only care that the first match of 4/3 and 4/4 exist. For example if there was a range of 4/3, 4/4, 4/5, 4/7, 4/8 this would produce 2 instances of the consecutive days since there was a break in sequence with nothing being recorded for 4/6.

Here is the code thus far. I realize that in the ELSE statement I have the record moving twice when the IDs don't match. It works sometimes but not on long runs and then it skips the first instance of the mismatch.

#### CODE --> vba

Dim strSQL As String
Dim rsA As DAO.Recordset
Dim rsB As DAO.Recordset

Set db = CurrentDb
strSQL = "SELECT tblUnexcused.SalesID, tblUnexcused.Dte, tblUnexcused.CallInLogFullName" _
& " FROM tblUnexcused" _
& " ORDER BY tblUnexcused.SalesID, tblUnexcused.Dte;"

Set rsA = CurrentDb.OpenRecordset(strSQL)

If Not rsA.BOF Then
rsA.MoveLast
rsA.MoveFirst '@ 1st record

Set rsB = rsA.Clone
rsB.MoveLast
rsB.AbsolutePosition = 1 '@ 2nd record

'----------------------------------
Do Until rsB.EOF

If rsA!salesid = rsB!salesid Then

Duration = DateDiff("D", rsA!dte, rsB!dte)

MsgBox rsA!salesid & ", " & rsA!dte & Chr(13) & rsB!salesid & ", " & rsB!dte & Chr(13) & "Duration in Days = " & Duration
rsA.MoveNext
rsB.MoveNext
Else
Duration = DateDiff("D", rsA!dte, rsB!dte)
MsgBox rsA!salesid & ", " & rsA!dte & Chr(13) & rsB!salesid & ", " & rsB!dte & Chr(13) & "Duration in Days = " & Duration, , "In Else b4 move"
rsA.Move 2
rsB.Move 2
MsgBox rsA!salesid & ", " & rsA!dte & Chr(13) & rsB!salesid & ", " & rsB!dte & Chr(13) & "Duration in Days = " & Duration, , "In Else after move"
End If
Loop

End If
'----------------------------------

Set rsB = Nothing
Set rsA = Nothing
Set db = Nothing 

It is crud as I am just playing with the scenarios and wanting to see what is being returned thus the message boxes. I am not sure that cloning is the right answer however I do not have the skills for arrays. I have thought possibly of doing case statements to test each entry per ID but still thinking that through. I confess I am not fluent in coding but understand most things and typically can find what I need and then tweak it to my needs. I appreciate anyone's time and insight on this project.

### RE: Group by ID and determine consecutive dates

Nice little exercise

(for some reason I could not include the SQL with the code, my SQL is below the code.)

#### CODE

Dim strSQL As String

Dim lngID As Long
Dim dte As Date
Dim R As Integer
Dim intConsDates As Integer

Set db = CurrentDb

See the SQL below *

Set rst = CurrentDb.OpenRecordset(strSQL)

With rst
.Open strSQL, Cn

If Not .EOF Then
.MoveLast
.MoveFirst
lngID = !ID.Value
dte = !dte.Value
.MoveNext

For R = 2 To .RecordCount
If lngID = !ID.Value And DateDiff("d", dte, !dte.Value) = 1 Then
If intConsDates <> R - 1 Then
Debug.Print lngID & " and dates: " & _
dte & " - " & !dte.Value & _
" are consecutive."
End If
intConsDates = R
End If

lngID = !ID.Value
dte = !dte.Value
.MoveNext
Next R
End If
.Close
End With
Set rst = Nothing 

* strSQL = "SELECT ID, Dte FROM tblUnexcused ORDER BY ID, Dte"

Have fun.

---- Andy

There is a great need for a sarcasm font.

### RE: Group by ID and determine consecutive dates

(OP)
Thank you Andy! I have been playing with other tactics that were close but no go for sequence beyond 3 sequential days. I was excited to see your reply so thank you for taking a crack at it. I copied it over but i am getting error 438, Object doesn't support this property or method. Its bombing here ->' With rst .Open strSQL, Cn ' I am not sure what the Cn is referencing? Am i missing a reference in the database?

So i rem'd the Open recordset line and it is working as intended. I went in to add a sql insert string to trap the outputs into a table for reporting. All works good and i am using dte as the firstdte however i am not sure how to get the second date (compared one) into a variable to write into the table?

Thank you again!
Anthony.

### RE: Group by ID and determine consecutive dates

Ooops.
I did my code in VB6 with ADODB (I am not an Access guy, can you tell?), so my code:
With rst
.Open strSQL, Cn

would translate to your Access as:
Set rst = CurrentDb.OpenRecordset(strSQL)

As for your second question - if you post your working code and tell what you want to happen, we can make it work

Have fun.

---- Andy

There is a great need for a sarcasm font.

### RE: Group by ID and determine consecutive dates

(OP)
Hey Andy,
Sitting here tinkering I was able to get it figured out! So far everything appears to be spot on. I can't thank you enough for the support. I have spent the last couple days with help from another trying to get past the 3 day scenario string.

For anyone else, here is my complete code that dumps to a table for reporting. I know some items have not been dimmed yet but I am ready to step away and take a break.

#### CODE --> vba

Dim strSQL As String
Dim strDsql As String
Dim strWsql As String

Dim lngID As Long
Dim dte As Date
Dim R As Integer
Dim intConsDates As Integer
Set db = CurrentDb

'SDate = #3/1/2017#
'EDate = #4/30/2017#
SDate = Forms!Frm2FerMain!TxtSDate.Value
EDate = Forms!Frm2FerMain!TxtEDate.Value

strSQL = "SELECT salesID, Dte,tblUnexcused.CallInLogFullName, tblUnexcused.ManagerOrCoach, tblUnexcused.Shift, tblUnexcused.Pay, tblUnexcused.Reason1, tblUnexcused.Reason2, tblUnexcused.Reason3" _
& " FROM tblUnexcused" _
& " WHERE tblUnexcused.Dte Between #" & SDate & "# And #" & EDate & "#" _
& " ORDER BY salesID, Dte"

'Clean out the tbl2Fer
strDsql = "DELETE * FROM Tbl2Fer"
CurrentDb.Execute strDsql

Set rst = CurrentDb.OpenRecordset(strSQL)

With rst
'.Open strSQL, cn

If Not .EOF Then
.MoveLast
.MoveFirst
lngID = !salesid.Value
dte = !dte.Value
.MoveNext

For R = 2 To .RecordCount
If lngID = !salesid.Value And DateDiff("d", dte, !dte.Value) = 1 Then
If intConsDates <> R - 1 Then
Debug.Print lngID & " and dates: " & _
dte & " - " & !dte.Value & _
" are consecutive."
firstdte = dte
seconddte = .Fields("Dte")
salesid = lngID
MC = .Fields("ManagerOrCoach")
Shift = .Fields("Shift")
Pay = .Fields("Pay")
FullName = .Fields("CallInLogFullName")
R1 = .Fields("Reason1")
R2 = .Fields("Reason2")
R3 = .Fields("Reason3")
strWsql = "INSERT INTO Tbl2Fer ( SDte, EDte, CallInLogFullName, ManagerOrCoach, SalesID, Shift, Pay, Reason1, Reason2, Reason3) VALUES (#" & firstdte & "#, #" & seconddte & "#, '" & FullName & "', '" & MC & "','" & salesid & "', '" & Shift & "', '" & Pay & "', '" & R1 & "', '" & R2 & "', '" & R3 & "')"
CurrentDb.Execute strWsql
End If
intConsDates = R
End If

lngID = !salesid.Value
dte = !dte.Value
.MoveNext
Next R
End If
.Close
End With
Set rst = Nothing
End Sub 

Thank you again Andy for being on this forum and offering your skills! So much appreciated!

### RE: Group by ID and determine consecutive dates

Good job !

"some items have not been dimmed yet" - use Option Explicit, VERY important. It saves you a lot of grief in debugging. Trust me.

A few minor 'suggestions':

#### CODE

Dim strSQL As String
'Dim strDsql As String
'Dim strWsql As String

Dim lngID As Long
Dim dte As Date
Dim R As Integer
Dim intConsDates As Integer
Set db = CurrentDb

'SDate = #3/1/2017#
'EDate = #4/30/2017#
SDate = Forms!Frm2FerMain!TxtSDate.Value
EDate = Forms!Frm2FerMain!TxtEDate.Value

'Clean out the tbl2Fer
strSQL = "DELETE * FROM Tbl2Fer"
CurrentDb.Execute strSQL

strSQL = "SELECT * " _
& " FROM tblUnexcused" _
& " WHERE Dte Between #" & SDate & "# And #" & EDate & "#" _
& " ORDER BY salesID, Dte"

Set rst = CurrentDb.OpenRecordset(strSQL)

With rst
If Not .EOF Then
.MoveLast
.MoveFirst
lngID = !salesid.Value
dte = !dte.Value
.MoveNext

For R = 2 To .RecordCount
If lngID = !salesid.Value And DateDiff("d", dte, !dte.Value) = 1 Then
If intConsDates <> R - 1 Then
'Debug.Print lngID & " and dates: " & _
'            dte & " - " & !dte.Value & _
'            " are consecutive."
firstdte = dte
seconddte = !Dte.Value
salesid = lngID
MC = !ManagerOrCoach.Value
Shift = !Shift.Value
Pay = !Pay.Value
FullName = !CallInLogFullName.Value
R1 = !Reason1.Value
R2 = !Reason2.Value
R3 = !Reason3.Value

strSQL = "INSERT INTO Tbl2Fer ( SDte, EDte, CallInLogFullName, ManagerOrCoach, SalesID, Shift, Pay, Reason1, Reason2, Reason3) VALUES (#" & firstdte & "#, #" & seconddte & "#, '" & FullName & "', '" & MC & "','" & salesid & "', '" & Shift & "', '" & Pay & "', '" & R1 & "', '" & R2 & "', '" & R3 & "')"
CurrentDb.Execute strSQL
End If
intConsDates = R
End If

lngID = !salesid.Value
dte = !dte.Value
.MoveNext
Next R
End If
.Close
End With
Set rst = Nothing
End Sub 

"spent the last couple days " (!) - ask for help. Live is too short

Kudos for not using spaces in your fields' names.
This allows you to use short rst!MyField.Value instead of rst.Fields("Tis is my field").Value

Have fun.

---- Andy

There is a great need for a sarcasm font.

### RE: Group by ID and determine consecutive dates

(OP)
Thank you Andy. "Last couple days" were spent trying to get it going while waiting on a response to this post! I learned a lot but still have way more to go! Thanks for the suggestions to clean things up, makes sense especially on the sql strings. I did have the debug.print commented out when I was running it and then did some testing to validate data and forgot to comment out again.

#### Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

#### Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Close Box

# Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!