when I input the "ToDate", I want to split the record
For example I want to calculate for the period 01FEB15 to 31DEC15,
when I input 31DEC15, I want the record to split up as follows creating two new records.
Expand|Select|Wrap|Line Numbers
- 01FEB15 to 11MAR15
- 12MAR15 to 04NOV15
- 05NOV15 to 31DEC15
Hi Everyone,
I have to split a set of dates depending on the dates in a background table.
Basically we have a rate rise for an item every so often.
Suppose I want to calculate the value between 01-Feb-15 and 21-Dec-15, it is quite simple if there is no rate change.
But in my calculations there is rate change on 12-Mar-15 and 05-Nov -15. Hence I have to break down the dates as
01-Feb-15 to 11-Mar-15
12-Mar-15 to 04-Nov-15
05-Nov-15 to 21-Dec-15
I have a rate change dates in a table called tblPRD
Expand|Select|Wrap|Line Numbers
- DORC DBPRC
- 11-Mar-10 3-Nov-10
- 4-Nov-10 9-Mar-11
- 10-Mar-11 09-Nov-11
- 10-Nov-11 7-Mar-12
- 8-Mar-12 31-Oct-12
- 1-Nov-12 6-Mar-13
- 7-Mar-13 06-Nov-13
- 7-Nov-13 5-Mar-14
- 6-Mar-14 5-Nov-14
- 6-Nov-14 11-Mar-15
- 12-Mar-15 04-Nov-15
- 5-Nov-15 9-Mar-16
- 10-Mar-16 2-Nov-16
Expand|Select|Wrap|Line Numbers
- Private Sub ToDate_AfterUpdate()
- Dim dDate As Date
- dDate = Nz(ToDate, 0)
- If dDate = 0 Then Exit Sub
- SplitDates dDate
- End Sub
- Sub SplitDates(dInDate As Date)
- 'On Error GoTo ErrorHandler
- Dim db As DAO.Database
- Dim rs As DAO.Recordset
- Dim s As String
- Dim sSQL As String
- Dim OriginalToDate As Date
- sSQL = "SELECT DORC, DBPRC FROM tblPRD ORDER BY DORC DESC;"
- 'Debug.Print sSQL
- Set db = CurrentDb
- Set rs = db.OpenRecordset(sSQL, dbOpenDynaset) 'dbOpenSnapshot dbOpenForwardOnly
- With rs
- .MoveLast 'force error 3021 if no records
- .MoveFirst
- Do Until .EOF
- If dInDate < .Fields("DORC") Then
- OriginalToDate = Me.ToDate
- Me.ToDate = .Fields("DBPRC")
- DoCmd.GoToRecord , , acNewRec
- .MovePrevious
- Do Until .Fields("DPRC") >= OriginalToDate
- If dInDate > .Fields("DORC") Then
- Me.FromDate = .Fields("DORC")
- Me.ToDate = .Fields("DBPRC")
- DoCmd.GoToRecord , , acNewRec
- .MovePrevious
- End If
- Loop
- End If
- .MoveNext
- Loop
- End With
- rs.Close
- GoTo ThatsIt
- ErrorHandler:
- Select Case Err.Number
- Case 3021
- Case Else
- MsgBox "Problem with SplitDates()" & vbCrLf _
- & "Error " & Err.Number & ": " & Err.Description
- End Select
- ThatsIt:
- If Not rs Is Nothing Then Set rs = Nothing
- If Not db Is Nothing Then Set db = Nothing
- End Sub
Thanks for any help..
Raghu