Help with multiple date ranges 5

[tigersden]

Can someone please help.
I have a table which stores date ranges of students training (tblTraining)with the following fields:
StudentID, FromDate, ToDate

I wish to use a form where the user can enter 2 dates eg StartDate & EndDate.
With these 2 dates entered I need to loop through tblTraining & return all the individual days for each student & write them back to a temporary table eg:

Form Data (User criteria)
txtStartDate= 10/02/05 txtEndDate= 12/02/05

tblTraining
StudentID FromDate ToDate
1 01/02/05 13/02/05
2 15/02/05 18/02/05
3 13/02/05 19/02/05
4 01/03/05 08/03/05
5 10/02/05 18/02/05

Results
StudentID Date
1 10/02/05
1 11/02/05
1 12/02/05
5 10/02/05
5 11/02/05
5 12/02/05
etc.................

Thanks in advance

 

[TheAceMan1]

How are ya tigersden . . . . .

Add a [blue]Command Button[/blue] and try this in the click event (I've used all the names you supplied). The code inserts directly into the [blue]temp table[/blue]:

[blue]   Dim db As DAO.Database, rst As DAO.Recordset, SQL As String
   Dim qStart As Date, qEnd As Date
   Dim Msg As String, Style As Integer, Title As String, DL As String
   
   DL = vbNewLine & vbNewLine
   Style = vbInformation + vbOKOnly
   
   If IsNull(Me!txtStartDate) Or IsNull(Me!txtEndDate) Then
      Msg = "At least one date is missing!" & DL & _
            "Check your dates and try again . . ."
      Title = "Missing Date(s) Notice! . . ."
      MsgBox Msg, Style, Title
   ElseIf Me!txtEndDate < Me!txtStartDate Then
      Msg = "EndDate is less that StartDate!" & DL & _
            "Check your dates and try again . . ."
      Title = "Reversed Start & End Dates!"
      MsgBox Msg, Style, Title
   Else
      Set db = CurrentDb
      Set rst = db.OpenRecordset("tblTraining", dbOpenDynaset)
      DoCmd.Hourglass True
      DoCmd.RunSQL "DELETE tblTemp.* FROM tblTemp;"
      
      Do
         If (rst!FromDate >= Me!txtStartDate And rst!FromDate <= Me!txtEndDate) Or _
            (rst!ToDate >= Me!txtStartDate And rst!ToDate <= Me!txtEndDate) Or _
            (rst!FromDate <= Me!txtStartDate And rst!ToDate >= Me!txtEndDate) Then
            
            If Me!txtStartDate >= rst!FromDate Then
               qStart = Me!txtStartDate
            Else
               qStart = rst!FromDate
            End If
            
            If Me!txtEndDate <= rst!ToDate Then
               qEnd = Me!txtEndDate
            Else
               qEnd = rst!ToDate
            End If
            
            Do
               SQL = "INSERT INTO tblTemp (StudentID, FromDate, ToDate) SELECT "
               SQL = SQL & rst!StudentID & ", #" & qStart & "#, #" & qEnd & "#;"
               DoCmd.RunSQL SQL
               qStart = qStart + 1
            Loop Until qStart > qEnd
         End If
         
         rst.MoveNext
      Loop Until rst.EOF
      
      DoCmd.Hourglass False
         
   End If[/blue]

[purple]Thats it . . . give it a whirl & let me know . . .[/purple]

See Ya! . . . . . .

 

[willir]

tigersden

Looping through and creating the dates is not a problem. The problem is knowing what dates not to include (Exception dates -- weekends, holidays, other unavailable dates)

You are using date ranges. Since using actual "available" Dates that will not be in a table, using VBA code may be more effective. Using a TEMP table or a dedicated table is not too important.

Since it seems that records will be created / deleted, you should remember to run "Compact and Repair" to recover unused space in the database.

The following read info from a form. But you can tweak it
Assumptions
- TrainingDate - Date field for training. (Avoid using reserved names when defining a table)

Dim rst as DAO.Recordset
Dim EndDate as Date, curDate as Date
Dim lngStudentID as Long

If IsDate(Me.StartDate) and IsDate(Me.EndDate) Then

   rst = CurrentDB.OpenRecordset("YourTable")

   lngStudentID = Me.StudentID  'Assume this is on table
   curDate = Me.StartDate
   EndDate = Me.EndDate

   Do While curDate < EndDate + 1

      If DateOkay(curDate) Then
         'See DateOkay function below
         'If True, write the record to table
         'The following will depend on your table design

         With rst
            .AddNew
               !StudentID = lngStudentID
               !TrainingDate = curDate
            .Update
         End With

      End If

      curDate = curDate + 1

   Loop

   rst.Close
   Set rst = Nothing

End If

And to check the date, you may wish to create a table, tblHolidays...

tblHolidays
HolidayDate - primary key, date field
Holiday - text

You will have to enter the holidays every year.
The following code is for a function that checks the date to decide if the date is a weekend or a holiday. A Saturday, Sunday or Holiday returns a False. Other date values return True.

Function DateOkay(dtDate As Date) As Boolean

Dim intDay As Integer, booOkay As Boolean
Dim strHoliday As String

booOkay = True

'Check for Saturday or Sunday, add days not to deliver

intDay = Weekday(dtDate)

'Tweak this section if you want to exclude other
'Days of the week, or remove it if the Day of the week
'is not important
Select Case intDay
   Case 1  'Sunday
      booOkay = False
   Case 7  'Saturday
      booOkay = False
End Select

'Now check for holidays

strHoliday = Nz(DLookup("Holiday", "tblHolidays", "HolidayDate = #" & dtDate & "#"), "")

If Len(strHoliday) Then
   booOkay = False
End If

'Return true, date is okay, not a weekend or holiday
'Return false, date is not okay, either a weekend or holiday
DateOkay = booOkay

End Function

Richard

 

[Eupher]

Dang, you guys are too quick! By the time I sorted this out, you had already posted. But mine is just a bit different, so I'll post it, too. My example assumes a saved table "tblResults" for the results, which gets emptied out each time the procedure is run. I also query for the records that intersect with the date range before starting the loop. FWIW...

Private Sub btnCalcDates_Click()
Dim dtSD As Date
Dim dtED As Date
Dim dtCurDate As Date
Dim CurDB As Database
Dim Rs1 As Recordset
Dim Rs2 As Recordset
Dim SQLStmt As String

dtSD = Me.SDate
dtED = Me.EDate

If IsDate(dtSD) And IsDate(dtED) Then
    If dtSD > dtED Then
        MsgBox "Time travel not allowed." & vbCrLf _
        & "Please ensure the End Date is equal to or greater than the Start Date."
        Exit Sub
    End If

Set CurDB = CurrentDb()

SQLStmt = "SELECT * FROM tblTraining " _
& "WHERE ((FromDate < #" & dtSD & "# And ToDate > #" & dtED & "#) " _
& "Or (FromDate Between #" & dtSD & "# And #" & dtED & "#) " _
& "Or (ToDate Between #" & dtSD & "# And #" & dtED & "#));"

Set Rs1 = CurDB.OpenRecordset(SQLStmt, dbOpenDynaset)
Set Rs2 = CurDB.OpenRecordset("tblResults")

'empty the Results table
Do While Not Rs2.EOF
    Rs2.Delete
    Rs2.MoveNext
Loop

'loop through the recordset and write dates that fall within the date range
Do While Not Rs1.EOF
    dtCurDate = Rs1("FromDate")
    'get our starting point within the date range from the form
    Do Until dtCurDate >= dtSD
        dtCurDate = dtCurDate + 1
    Loop
    'write the dates
    Do Until dtCurDate > dtED Or dtCurDate > Rs1("ToDate")
        With Rs2
            .AddNew
                !StudentID = Rs1("StudentID")
                !TrainingDate = dtCurDate
            .Update
        End With
        dtCurDate = dtCurDate + 1
    Loop
    Rs1.MoveNext
Loop
Rs1.Close
Rs2.Close
Set CurDB = Nothing

End If

End Sub

One of these ought to get you on the right track...

Ken S.

 

[tigersden]

Hi All,
Firstly thanks to TheAceMan1, willir & Eupher for your replies. I will try them all but the holidays is an issue I had not thought about, thanks for suggesting that.

Willir you mention to run compact & repair, does anyone know if you can do this with code rather than using the menu?

I am now going to try each of the codes out & will let you know how I get on.

Thanks to you all.
Tim

 

[TheAceMan1]

tigersden . . . . .

Forgot to copy over some changes in the code. Particularly in the SQL for the tblTemp. So discard the old and use the following:

[blue]   Dim db As DAO.Database, rst As DAO.Recordset, SQL As String
   Dim qStart As Date, qEnd As Date
   Dim Msg As String, Style As Integer, Title As String, DL As String
   
   DL = vbNewLine & vbNewLine
   Style = vbInformation + vbOKOnly
   
   If Not IsDate(Me!txtStartDate) Or Not IsDate(Me!txtEndDate) Then
      Msg = "At least one date is missing!" & DL & _
            "Check your dates and try again . . ."
      Title = "Missing Date(s) Notice! . . ."
      MsgBox Msg, Style, Title
   ElseIf Me!txtEndDate < Me!txtStartDate Then
      Msg = "EndDate is less that StartDate!" & DL & _
            "Check your dates and try again . . ."
      Title = "Reversed Start & End Dates!"
      MsgBox Msg, Style, Title
   Else
      Set db = CurrentDb
      Set rst = db.OpenRecordset("tblTraining", dbOpenDynaset)
      DoCmd.Hourglass True
      DoCmd.RunSQL "DELETE tblTemp.* FROM tblTemp;"
      
      Do
         If (rst!FromDate >= Me!txtStartDate And rst!FromDate <= Me!txtEndDate) Or _
            (rst!ToDate >= Me!txtStartDate And rst!ToDate <= Me!txtEndDate) Or _
            (rst!FromDate <= Me!txtStartDate And rst!ToDate >= Me!txtEndDate) Then
            
            If Me!txtStartDate >= rst!FromDate Then
               qStart = Me!txtStartDate
            Else
               qStart = rst!FromDate
            End If
            
            If Me!txtEndDate <= rst!ToDate Then
               qEnd = Me!txtEndDate
            Else
               qEnd = rst!ToDate
            End If
            
            Do
               [purple]SQL = "INSERT INTO tblTemp (StudentID, qDate) SELECT "
               SQL = SQL & rst!StudentID & ", #" & qStart & "#;"[/purple]
               DoCmd.RunSQL SQL
               qStart = qStart + 1
            Loop Until qStart > qEnd
         End If
         
         rst.MoveNext
      Loop Until rst.EOF
      
      DoCmd.Hourglass False
      
      [purple]Set rst = Nothing
      Set db = Nothing[/purple]
         
   End If[/blue]

See Ya! . . . . . .

 

[tigersden]

Hi,
TheAceMan1 I have tried your code & it works great.
I am having problems with the way dates are getting stored in the tblTemp. eg I used the following date ranges on the search form 01/08/2004 to 15/08/2004 when I checked the tblTemp some dates from & including 01/08/2004 to 12/08/2004 are stored as 08/01/2004 to 08/12/2004 For the remainder they are correct 13/08/2004 to 15/08/2004.
It seems the dates are getting formatted to MM/DD/YYYY when in the existing table they are stored DD/MM/YYYY
I hope this makes sense to you.
Any advice??
Thanks
Tim

 

[PHV]

Replace this:
SQL = SQL & rst!StudentID & ", #" & qStart & "#;"
By this:
SQL = SQL & rst!StudentID & ", #" & Format(qStart, "yyyy-mm-dd") & "#;"

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[Eupher]

tigersden,
Yes, you can compact and repair via code:

Private Sub Command1_Click()
   CommandBars("Menu Bar"). _
   Controls("Tools"). _
   Controls("Database utilities"). _
   Controls("Compact and repair database..."). _
   accDoDefaultAction
End Sub

From thread705-642227
HTH

Ken S.

 

[TheAceMan1]

tigersden . . . . .

There's an ambiguity between [blue]how access converts a date for its use or storage[/blue] and [blue]the format your using for data entry[/blue] (Day/Month/Year). Bear the following in mind:
[ol][li]Access converts as necessary and stores dates as Month/Day/Year. [blue]Its not that its converted to this format[/blue], as dates are really Integers! [purple]Its that the conversion algorithm builds the integer based on returning this premise as the standard![/purple][/li]
[li]Any formatting of a date in a field or control, is [blue]strictly for display purposes only.[/blue] [purple]Formatting does not tell access how to convert or give the conversion any clues.[/purple] [blue]The actual value in the field is always as in 1 above.[/blue][/li][/ol]
Now consider this:

You enter 10/02/05 in a date field. To Access this is an [blue]legimate Month/Day/Year entry[/blue] and no conversion is required. If your formatting the field, it will display as you have it set Day/Month/Year or 02/10/05. Still Wrong!

You enter 13/02/05. Problem! [blue]Access believes 13 (the highest number) is the year[/blue], and [purple]that your entering Year/Month/Day[/purple], so conversion turns out to be 02/05/2013. If your formatting it would look like 05/02/13 which is still wrong!

This creates the same problem when trying to convert properly in VBA.

To fix this without having to get use to some other format, you can [blue]fully qualify your data entry[/blue] to Access with 10 Feb 05 or 13 Feb 05.

You can validate what happens by typing in your format in any date field of a table.

[purple]Hope this helps . . . . .[/purple]

See Ya! . . . . . .

 

[Eupher]

Tigersden,
I'm giving you a star because your question helped me a great deal. I have a database that, among many other things, produces a report of people on vacation. The report is organized by day - so there is a line item for each person on every day they are on vacation. My method basically involved running a query against every date in the date range; suffice it to say that it worked, but was horribly inefficient and *very* slow.

When I saw your question, a little lightbulb popped on right above my head, just like in the comic books. I saw a new way to organize the data. Using a variation on the code I posted above, the report that might previously have taken 30 minutes(!!) to run now takes about 8 seconds. On a side note, in my debugging I discovered that, depending on the number of records in the Results table, it can be substantially quicker just to destroy and re-create the tabledef at runtime than to delete the records by stepping through the recordset (although either way was a quantum leap better than the old method).

Thank you!

Ken S.