Challenging DateDif Loop question

[DISI]

I need to loop thru a record set to determine gaps in enrollment dates and the number of gaps between a start and end date range. A 1 day gap (end date 1/1/01 - start date 1/2/01) is not considered a gap. Here is some sample data and desired output: Tbl_Enrollment Date Range of interest: 1/1/01 to 5/1/01

ID StartDate EndDate
1 12/1/00 1/1/01
1 1/1/01 1/2/01
1 1/2/01 2/1/01
1 2/15/01 2/28/01
1 2/28/01 3/31/01
1 4/15/01 6/1/01

Output:
ID GapDays GapTimes
1 27 2

Here is the reasoning:
1st gap: 2/1/01 to 2/15/01 13 days
2nd gap: 3/31/01 to 4/15/01 14 days

Appreciate any help here. Thanks in advance. Paul Faculjak
paul@DataIntegritySolutions.com

 

[monsjic]

If you were doing this in a query, the SQL would look like below:

SELECT DateDiff("d",StartDate,EndDate)-1
FROM TableWithDates;

 

[cmmrfrds]

If you want to do all the processing on the client, then an ADO fabricated recordset may be a good solution. You would load your retrieved recordset into the ADO recordset where you could perform the filtering operations. The steps are to order the ADO recordset in the order you need such as ID and BeginDate then step through the recordset one record at a time. To compare the begin date to the previous end date set up a function and pass the ADO recordset to the function where you can filter for the previous record and then compare that end date to the begin date of the record you are on. Reset the filter before leaving the function. You would need to add some BOF and EOF logic.

You could add 2 extra fields to the fabricated recordset for gap and gap number. When you find a gap insert the days into the gap field and a 1 into the gap number. After you are finished going through the ADO recordset. You can go through an print out the gap information by equating the final resultset where you group by ID to the recordsource of a Form.

 

[DISI]

cmmrfrds,

What you described is what I thought I needed. However, I am not a programmer. I understand in concept, but can't translate it into code. Is if possible to help me out further here? Thanks.
Paul Paul Faculjak
paul@DataIntegritySolutions.com

 

[MichaelRed]

The Table:
Id StartDate EndDate
1 12/1/00 1/1/01
1 1/1/01 1/2/01
1 1/2/01 2/1/01
1 2/15/01 2/28/01
1 2/28/01 3/31/01
1 4/15/01 6/1/01
2 2/1/01 2/14/01
2 2/16/01 3/1/01
2 3/3/01 3/28/01
2 4/1/01 5/1/01
2 5/12/01 5/29/01

Public Function basGap()

    'Michael Red 1/30/2001
    'Sample Usage:
    '? basGap
    'Output:
    'ID     GapDays     GapTimes
    ' 1      27          2
    ' 2      15          4

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset

    Dim Idx As Integer
    Dim MyId As Integer
    Dim MyStrtDt As Date
    Dim MyEndDt As Date
    Dim MyGapDays As Integer

    Set dbs = CurrentDb
    'ASSUMES t5bl_Enrollment is ordered by [Id]
    Set rst = dbs.OpenRecordset("Tbl_Enrollment", dbOpenDynaset)

    If (Not rst.EOF) Then
        ReDim MyGap(0)
     Else
        MsgBox "No Entries in Specified Table", vbokomly, "Gap Counter Error"
        Exit Function
    End If

    'Initalize w/ first record
    With rst
        MyId = !ID
        MyGap(Idx).GapId = MyId
        MyStrtDt = !StartDate
        MyEndDt = !EndDate
        rst.MoveNext
    End With

    'So Actual Calcs Start w/ 2nd Record
    Do While Not rst.EOF
        If (rst!ID <> MyId) Then
            'Logic to &quot;Move On&quot; to Next ID set
            Idx = Idx + 1
            ReDim Preserve MyGap(Idx)
            MyId = rst!ID
            MyGap(Idx).GapId = MyId
         Else
            'Process record fro SAME Id
            MyGapDays = DateDiff(&quot;d&quot;, MyEndDt, rst!StartDate)
            If (MyGapDays > 1) Then
                With MyGap(Idx)
                    .GapDays = .GapDays + MyGapDays - 1
                    .GapCount = .GapCount + 1
                End With
            End If
        End If
        MyStrtDt = rst!StartDate
        MyEndDt = rst!EndDate
        rst.MoveNext
    Loop

    'Output is still a problem.  KnowBody Knows the trouble w/ I/O ...
    'Still, for Illustration via DeBug
    Idx = 0                         'Just LBound of the array
    Debug.Print &quot;Output:&quot;
    Debug.Print &quot;ID&quot;; Tab(8); &quot;GapDays&quot;; Tab(20); &quot;GapTimes&quot;
    Do While Idx <= UBound(MyGap)
        With MyGap(Idx)
            Debug.Print .GapId; Tab(8); .GapDays; Tab(20); .GapCount
        End With
        Idx = Idx + 1
    Loop

End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[cmmrfrds]

Hi Paul. I can give you a partial solution much like MichaelRed. The output in an Access Form/Report is a problem. My solution is lacking in being able to return a recordset to the recordsource on an Access Form. Here is the code up to that point from an Access Form. This uses a recordset instead of an array to manipulate the data this is more powerful than an array in that you can use all the features on a recordset like sort, filter, indexes, etc... in your manipulation of the data. You could apply this same logic in an ASP and the output would not be a problem. You could, of course, write the ADO recordset back to an Access table and Retrieve the resultset back to the Form's recordsource.

Option Compare Database
Option Explicit
Public recCount As Integer
Public rs1 As New ADODB.Recordset

Private Sub Form_Open(Cancel As Integer)
Dim cn As New ADODB.Connection, Sql1 As String
Dim rs As New ADODB.Recordset

Set cn = CurrentProject.Connection
'--- Get recordset from the database
Sql1 = "select * from IDTable order by ID, startdate"
rs.Open Sql1, cn, adOpenStatic, adLockReadOnly
rs.MoveFirst
recCount = rs.RecordCount
'--- Build an internal recordset to manipulate data
Call CreateRecordset(rs)

'-- not able to return the resultset to the recordsource so can't display on Form
''Me.RecordSource = rs1
rs.Close
Set rs = Nothing

End Sub

Public Function CreateRecordset(rs As ADODB.Recordset)
'-- create a fabricated recordset
With rs1.Fields
.Append "ID", adInteger
.Append "startdate", adDBDate
.Append "enddate", adDBDate
.Append "gap", adInteger, adFldIsNullable
.Append "gapNum", adInteger, adFldIsNullable
End With

Dim arrFields As Variant
arrFields = Array("ID", "startdate", "enddate", "gap", "gapNum&quot

Dim indx As Integer
'''''''''Debug.Print "in Createrecordset "; recCount
rs1.Open
rs.MoveFirst
For indx = 0 To recCount - 1
rs1.AddNew arrFields, Array(rs!ID, rs!startdate, rs!enddate, 0, 0)
rs.MoveNext
Next '- end of recordset

Dim theGap As Integer
rs1.MoveFirst
rs1.MoveNext '-- start with 2nd record
While Not rs1.EOF
theGap = FindRecord(rs1!ID, rs1!startdate, rs1)
rs1!gap = theGap
rs1!gapNum = 1
'''''''Debug.Print "gap update"; rs1!gap; " , "; rs1!gapNum
rs1.Update
rs1.MoveNext
Wend

End Function

Public Function FindRecord(prmID As Integer, prmSdate As Date, rs1 As Recordset) As Integer
''-- Get the prior enddate and subtract and return difference
Dim tempenddate As Date, aGap As Integer
rs1.MovePrevious
tempenddate = rs1!enddate
aGap = DateDiff("d", tempenddate, prmSdate)
rs1.MoveNext
''''Debug.Print "the gap = "; aGap
FindRecord = aGap

End Function

 

[DISI]

cmmrfrds

Thanks to you and MichaelRed. I didn't get an email notification, otherwise I'd have responded sooner.

I feel like I'm getting closer, but its still out of reach. I feel so ignorant reading your code. I see you have me setting the first code to a form open event. I don't need the form, other than to start your code. (?) I'd like to write the ADO recordset back to an Access table like you suggested. How do I make that happen?

I'm thrilled that you've brought me this close.. Thanks.

Paul Faculjak

 

[cmmrfrds]

*This will reference the access table you want to update which will be empty to start with. You will need to delete the records when you are finished.

Dim cn As New ADODB.Connection, Sql1 As String
Dim rs2 As New ADODB.Recordset

Set cn = CurrentProject.Connection
'--- Get recordset from the database
Sql1 = "select * from yourtable"
rs2.Open Sql1, cn, adOpenStatic, adLockBatchOptimistic

*assume you have the same fields in yourtable and rs1 is open
Dim indx As Integer
rs1.MoveFirst
For indx = 0 To recCount - 1
rs2.AddNew arrFields, Array(rs1!ID, rs1!startdate, rs1!enddate, rs1!gap, rs1!gapNum)
rs.MoveNext
Next '- end of recordset
rs2.update

*data should be in yourtable
*now you can retrieve recordset to a form's recordsource
dim sql2 as string

sql2 = "Select ID, sum(gap), sum(gapNum) "
sql2 = sql2 + "from yourtable group by ID order by ID"
*this below will populate the Form
me.recordsource = sql2

dim sql3 as string
sql3 "delete from yourtable"
rs2.Open Sql3, cn, adOpenStatic, adLockBatchOptimistic

rs2.close
set rs2 = nothing

*Note in my previous code, only put a 1 in gapNum if there is a gap. The sum on gap will sum up the days you put in the gap and the 1 where there was a gap will sum the number of gaps.

*Note2 you can always look at the results of the debug.print by doing a Control G which will bring up the debug output.

*There may be syntax errors since I did not run this last code.

 

[DISI]

cmmrfrds

You've been so persistent. Thank you. Unfortunately I am losing you along the way. I've got a small mdb file with sample data and the code you've written. Can I send it to you?

I don't know what to call the result table? I also get an error when I run the code. Ideally, I'd like to put all of this in a function I can call from a cmd button on a form. I appreciate your assistance.

paul@dataintegritysolutions.com

Paul Paul Faculjak
paul@DataIntegritySolutions.com

 

[cmmrfrds]

You can send it to cmmrfrds@home.com but I probably won't have a chance to look at it this weekend.