Split record....

[hrprabhu]

I have to calculate something and the rate changes two or three times year. This year the dates of rate change are 12MAR15 AND 04NOV15.

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.

01FEB15 to 11MAR15
12MAR15 to 04NOV15
05NOV15 to 31DEC15

Thanks...

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

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

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

The code seems to be falling over…

Thanks for any help..

Raghu

[zmbd]

1) Second post was much better than your first. :)
I've merged these two posts adding only the formatting around your tabular data.

2) Most experts here will not download an unrequested file.

3) What do you mean by the "The code seems to be falling over…" please do the basic trouble shooting as outlined in the following link ( > Before Posting (VBA or SQL) Code ) the debug/compile may require several runs before all of the simple errors are fixed. Quite simply, many of us do not have your PC and dataset here to be able to do this basic trouble shooting step for you.

I do see a few things, line 22... do a record count check instead of forcing an error - one does not need an accurate record count, if any record is returned then the count>=1 else count=0

IF rs.recordcount THEN
   (... code here if count>=1)
  ELSE
    (... code here if count<=0)
ENDIF

Your goto in line 43 should be avoided. Instead, replace line 43 with an exitsub
Move lines 52,53 before the exitsub
Insert a return label just after the exitsub so that your error will resume at that point
Place a Resume labelhere at the end of your error trap... generic air code:

SUB CodeNameHere()
   (start of code)
   ON Error Goto zErrorTrap
   (main code here)
zResumeFromError:
   (cleanup code here)
Exit Sub
zErrorTrap:
   (error handling code here}
   Resume zResumeFromError
End Sub

The remainder of your code, just doesn't make any sense what so ever. (lines 24 thru 40 ) It just doesn't appear to be doing much of anything.

Once you have your first SQL set-up (and/or your corrected VBA), even if it works :), post it here (please use the [CODE/] formatting tool to properly format the SQL) and we can go from there.

4) I don't think this applies here however, The Partition() Function (read more) it's an interesting function and it may prove of use; however, it's hard to tell from your code and lack of data doesn't help, you might only need a simple Between criteria and a table with the date ranges.

In any case, you normally shouldn't need to be duplicating this data in your database if it is properly designed.

thnx
-z

[hrprabhu]

Apologies for the delay. When the big “C” strikes everything becomes out of focus.

[zmbd]

no worries... we don't usually close threads due to age - when you get a chance and things work out to do so post as you can. :-)