Writing a routine to create sequential records

Question

I would like to write a routine which will allow me to take dated events (records) in a table which span accross a set time frame and in the cases where no event took place

Answer 1

Private Sub Command109_Click()

    On Error GoTo errhandler

    Dim rsEvents As Recordset
    Dim EventDate As Date
    Dim ProjID As String
    Dim Fld1 As String
    Dim Fld2 As String
    Dim Fld3 As String
    Dim Fld4 As String
    Dim Fld5 As String
    Dim Fld6 As String
    Dim Fld7 As String
    Dim Fld8 As String
    Dim Fld9 As String
    Dim Fld10 As String
    Dim Fld11 As String
    Dim Fld12 As String
    Dim Fld13 As String
    Dim Fld14 As String
    Dim Fld15 As String
    Dim Fld16 As String
    Dim Fld17 As String
    Dim Fld18 As String
    Dim Fld19 As String
    Dim Fld20 As String
    Dim Fld21 As String

    Dim st_sql As String
    Dim Sql As String

    Me.Refresh

    Set rsEvents = CurrentDb.OpenRecordset("SELECT * FROM tblProjectMasterListHistory02 ORDER BY LastUpdateDate")
    'Save the current date and info

    EventDate = rsEvents("LastUpdateDate")
    ProjID = rsEvents("ID Project")
    Fld1 = rsEvents("OverallPrincipleStatus1")
    Fld2 = rsEvents("OverallPrincipleStatus2")
    Fld3 = rsEvents("OverallObjectiveStatus")
    Fld4 = rsEvents("OverallObjectiveStatus2")
    Fld5 = rsEvents("OverallDependencyStatus1")
    Fld6 = rsEvents("OverallDependencyStatus2")
    Fld7 = rsEvents("OverallAssumptionsStatus1")
    Fld8 = rsEvents("OverallAssumptionsStatus2")
    Fld9 = rsEvents("OverallConstraintsStatus1")
    Fld10 = rsEvents("OverallConstraintsStatus2")
    Fld11 = rsEvents("ObjectivesScope")
    Fld12 = rsEvents("ObjectivesResources")
    Fld13 = rsEvents("ObjectivesProjectPlan")
    Fld14 = rsEvents("ObjectivesEffort")
    Fld15 = rsEvents("ObjectivesBenefits")
    Fld16 = rsEvents("ObjectivesResourceMobilisation")
    Fld17 = rsEvents("ObjectivesMetrics")
    Fld18 = rsEvents("OverallRiskStatus1")
    Fld19 = rsEvents("OverallRiskStatus2")
    Fld20 = rsEvents("GovernanceStatus1")
    Fld21 = rsEvents("GovernanceStatus2")

    rsEvents.MoveNext

    Do

     ' Loop through each blank date

        Do While EventDate < rsEvents("LastUpdateDate") - 1 'for all dates up to, but not including the next date
            EventDate = EventDate + 1 'advance date by 1 day
            rsEvents.AddNew
            rsEvents("LastUpdateDate") = EventDate
            rsEvents("ID Project") = ProjID
            rsEvents("OverallPrincipleStatus1") = Fld1
            rsEvents("OverallPrincipleStatus2") = Fld2
            rsEvents("OverallObjectiveStatus") = Fld3
            rsEvents("OverallObjectiveStatus2") = Fld4
            rsEvents("OverallDependencyStatus1") = Fld5
            rsEvents("OverallDependencyStatus2") = Fld6
            rsEvents("OverallAssumptionsStatus1") = Fld7
            rsEvents("OverallAssumptionsStatus2") = Fld8
            rsEvents("OverallConstraintsStatus1") = Fld9
            rsEvents("OverallConstraintsStatus2") = Fld10
            rsEvents("ObjectivesScope") = Fld11
            rsEvents("ObjectivesResources") = Fld12
            rsEvents("ObjectivesProjectPlan") = Fld13
            rsEvents("ObjectivesEffort") = Fld14
            rsEvents("ObjectivesBenefits") = Fld15
            rsEvents("ObjectivesResourceMobilisation") = Fld16
            rsEvents("ObjectivesMetrics") = Fld17
            rsEvents("OverallRiskStatus1") = Fld18
            rsEvents("OverallRiskStatus2") = Fld19
            rsEvents("GovernanceStatus1") = Fld20
            rsEvents("GovernanceStatus2") = Fld21

            rsEvents.Update

        Loop

        ' get new current date and info
        EventDate = rsEvents("LastUpdateDate")
        ProjID = rsEvents("ID Project")
        Fld1 = rsEvents("OverallPrincipleStatus1")
        Fld2 = rsEvents("OverallPrincipleStatus2")
        Fld3 = rsEvents("OverallObjectiveStatus")
        Fld4 = rsEvents("OverallObjectiveStatus2")
        Fld5 = rsEvents("OverallDependencyStatus1")
        Fld6 = rsEvents("OverallDependencyStatus2")
        Fld7 = rsEvents("OverallAssumptionsStatus1")
        Fld8 = rsEvents("OverallAssumptionsStatus2")
        Fld9 = rsEvents("OverallConstraintsStatus1")
        Fld10 = rsEvents("OverallConstraintsStatus2")
        Fld11 = rsEvents("ObjectivesScope")
        Fld12 = rsEvents("ObjectivesResources")
        Fld13 = rsEvents("ObjectivesProjectPlan")
        Fld14 = rsEvents("ObjectivesEffort")
        Fld15 = rsEvents("ObjectivesBenefits")
        Fld16 = rsEvents("ObjectivesResourceMobilisation")
        Fld17 = rsEvents("ObjectivesMetrics")
        Fld18 = rsEvents("OverallRiskStatus1")
        Fld19 = rsEvents("OverallRiskStatus2")
        Fld20 = rsEvents("GovernanceStatus1")
        Fld21 = rsEvents("GovernanceStatus2")

        rsEvents.MoveNext
        'new records are placed on the end of the recordset
        'so if we hit an older date, we know it's a recent insert and quit

    Loop Until rsEvents.EOF Or EventDate > rsEvents("LastUpdateDate")


errhandler:

End Sub