Access Form - Loop thru all records of form to recalculate form results

[FryGirl]

I have a form with 1701 records which I can see by the record selector at the bottom of the form.

This form has calculations performed on the On Current event. I need to cycle thru all 1701 records so they can get recalculated.

Short of me pushing the next record button 1701 times, is there some code to loop thru all the records with maybe a 3 sec pause between each loop?

 

[Joe4]

What exactly is the "On Current" event doing?
Can you post the code behind it?
Is it updating bound fields or unbound fields?

 

[FryGirl]

I did not write this code, so not sure all its doing and I would say these are bound fields.

Function ReviewDates(frm As Form)
'DECLARATIONS:
'~~~~~~~~~~~~~
    Const C_PROC_NAME = "ReviewDates"
    Dim strDate As String
    Dim Ldate As Date
    Dim intAdjust As Integer
    'INITIALIZE:
    '~~~~~~~~~~~
    If gcfErrHandlerrors Then On Error GoTo ErrHandler
    
    Select Case frm Is Nothing
    Case True
        Set frm = Me
    Case False
    End Select
    'ToDo: this is dangerous error handling evaluate for normal error processing
    On Error Resume Next
    
    With frm
        'Make Sure the date addition fields are numbers for math
        Me.Duration = Nz(Me.Duration, 0)
        TECntEst.Value = Nz(Me.PHASE.Column(2), 0)  'CycleDays Field
        txtTargetAdjDays.Value = IIf(IsNumeric([txtTargetAdjDays]), [txtTargetAdjDays], 0)
        txtTargetTotalDays.Value = Me.txtTargetAdjDays.Value + Me.TxtCycleDays.Value ' Study Specific adjusted Cycle Days
        YellowDays = txtTargetTotalDays * 0.8
    
    Select Case Nz(Me.[Status].[Column](0), 0)
    Case 1  ' Not In Progress
'        Me.lblRYG.visible = True
            Select Case IsDate(Me.TStartDate) ' is the StartDate populated?
                Case True ' calculate in the Projected End Date
                    TargetNew.Value = DateAdd("d", txtTargetTotalDays, TStartDate)
                    Me.Duration = IIf(IsDate(Me.[TStartDate]), _
                                      DateDiff("d", Me.[TStartDate], _
                                      IIf(IsDate(Me.[TEndDate]), _
                                      Me.[TEndDate], Date)), 0)
                    Me.TEndDateESt.Value = TargetNew.Value
                    'Me.txtDaysYellow.Value
                Case False 'StartDate missing
                    Select Case IsDate(Me.TStartDateEst) 'Can we fill in Estimated End Date?
                        Case True ' Fill in the estimated end based on the date adjustments
                            TargetNew.Value = DateAdd("d", txtTargetTotalDays, TStartDateEst)
                            Me.TEndDateESt.Value = TargetNew.Value
'ToDo:  Do we want to have a duration only for actuals or estimates?  If "yes" uncomment below
'                            Me.Duration = IIf(IsDate(Me.[TStartDateEst]), _
                                              DateDiff("d", Me.[TStartDateEst], _
                                              IIf(IsDate(Me.[TEndDateESt]), _
                                              Me.[TEndDateESt], Date)), 0)
                    End Select
            End Select
    Case 2 ' In Progress
'        Me.lblRYG.visible = True
            Select Case IsDate(TStartDate) ' is the StartDate populated?
                Case True ' calculate in the Projected End Date
                    TargetNew.Value = DateAdd("d", txtTargetTotalDays, TStartDate)
                    Me.Duration = IIf(IsDate(Me.[TStartDate]), _
                                      DateDiff("d", Me.[TStartDate], _
                                      IIf(IsDate(Me.[TEndDate]), _
                                      Me.[TEndDate], Date)), 0)
                    'Me.txtDaysYellow.Value
                Case False 'StartDate missing
                    frm.TStartDate = Date
                    Select Case IsDate(TStartDateEst) 'Can we fill in Estimated End Date?
                        Case True ' Fill in the estimated end based on the date adjustments
                            TargetNew.Value = DateAdd("d", txtTargetTotalDays, TStartDateEst)
'ToDo:  Do we want to have a duration only for actuals or estimates?  If "yes" uncomment below
'                            Me.Duration = IIf(IsDate(Me.[TStartDateEst]), _
                                              DateDiff("d", Me.[TStartDateEst], _
                                              IIf(IsDate(Me.[TEndDateESt]), _
                                              Me.[TEndDateESt], Date)), 0)
                    End Select
            End Select
    Case 3, 6 ' Not Started
'        Me.lblRYG.visible = True
            Select Case IsDate(TStartDate) ' is the StartDate populated?
                Case True ' calculate in the Projected End Date
                    TargetNew.Value = DateAdd("d", txtTargetTotalDays, TStartDate)
                        Me.Duration = IIf(IsDate(Me.[TStartDate]), _
                                          DateDiff("d", Me.[TStartDate], _
                                          IIf(IsDate(Me.[TEndDate]), _
                                          Me.[TEndDate], Date)), 0)
                    'Me.txtDaysYellow.Value
                Case False 'StartDate missing
                    Select Case IsDate(TStartDateEst) 'Can we fill in Estimated End Date?
                        Case True ' Fill in the estimated end based on the date adjustments
                            TargetNew.Value = DateAdd("d", txtTargetTotalDays, TStartDateEst)
                            TEndDateESt.Value = TargetNew.Value
                            Me.TEndDate.Value = TargetNew.Value
'ToDo:  Do we want to have a duration only for actuals or estimates?  If "yes" uncomment below
'                            Me.Duration = IIf(IsDate(Me.[TStartDateEst]), _
                                              DateDiff("d", Me.[TStartDateEst], _
                                              IIf(IsDate(Me.[TEndDateESt]), _
                                              Me.[TEndDateESt], Date)), 0)
                    End Select
            End Select
    End Select
Me.Repaint
    TempVars.Add "tvMyCycleDays", Me.PHASE.Column(2).Value ' Based on the existing ComboBox
    TempVars.Add "tvMyTargetDays", Me.txtTargetTotalDays.Value     '
    TempVars.Add "tvMyStartDate", IIf(IsDate(TStartDate), Me.TStartDate.Value, IIf(IsDate(TStartDateEst), Me.TStartDateEst.Value, Date))
    TempVars.Add "tvMyDurationDays", Me.Duration.Value
    TempVars.Add "tvDayYellow", Me.YellowDays.Value 'YellowDays
    TempVars.Add "tvMyTargetNew", Me.TargetNew.Value
    
'ToDo: Delete if RYG status no longer required
    
'    Select Case Me.[Status].[Column](0)
'    Case 1, 2 '"Not Started", "In Progress"
'            Me.lblRYG.visible = True
'           Select Case Date
'            Case Is > [TempVars]![tvMyTargetNew] ' Red
'                Me.lblRYG.Caption = "R"
'                Me.lblRYG.BackColor = vbRed
'                Me.lblRYG.ForeColor = vbWhite
'                Me.lblRYG.visible = True
'                TempVars.Add "tvTaskRYGStatus", 3
'                TempVars.Add "tvTaskRYG", "R"
'            Case Is >= DateAdd("d", [TempVars]![tvDayYellow], [TempVars]![tvMyStartDate]) ' Yellow
'                Me.lblRYG.Caption = "Y"
'                Me.lblRYG.BackColor = vbYellow
'                Me.lblRYG.ForeColor = vbBlack
'                Me.lblRYG.visible = True
'                TempVars.Add "tvTaskRYGStatus", 2
'                TempVars.Add "tvTaskRYG", "Y"
'            Case Else ' Green
'                Me.lblRYG.Caption = "G"
'                Me.lblRYG.BackColor = vbGreen
'                Me.lblRYG.ForeColor = vbBlack
'                Me.lblRYG.visible = True
'                TempVars.Add "tvTaskRYGStatus", 1
'                TempVars.Add "tvTaskRYG", "G"
'            End Select
'        Case 3, 4, 5 ' Completed, Delay, Cancelled
'            Me.lblRYG.visible = False
'        End Select
    DoCmd.RunCommand acCmdSave    ' Save at this point
End With
    'WRAP-UP
    '~~~~~~~
    Call ftvProjectTVs
WrapUp:
    'cCursor.Restore '    Replaces DoCmd.Hourglass False
    Exit Function    ' or     Exit Function
    'ERROR HANDLER
    '~~~~~~~~~~~~~
ErrHandler:
    Select Case Err
    Case 0
        'Not really an error
        Err.Clear
        Resume Next
    Case Else
        Call LogError(fnErrLvl.Minor, Err, DAO.DBEngine.Errors, C_MODULE_NAME, C_PROC_NAME, strErrNotes, Erl)
    End Select
    Resume WrapUp
    '    Resume Next
    '    Resume
End Function

 

[Joe4]

I did not write this code, so not sure all its doing and I would say these are bound fields.

I would not make that assumption. It is important to know for sure, whether or not that is happening.

There seems to be an awful lot going on there. What exactly is this form doing when you open it up?

I cannot believe the user intended to have to do it that way (cycle through all the records to update them). That would be extremely poor design.
You would typically use an Update Query or other VBA code (not tied to a Form event) if all records needed to be updated.

More commonly, you might see a bunch of calculations like that for display purposes (which would typically be updating unbound fields).
But if they were unbound, none of those calculations would be saved. In that case, there would be no need to cycle through all the records.

One way to check may be to look at some record in the underlying table, and note the values in each field (maybe export the table to an Excel file for easy reference).
Then, open that record in your form, then close it.
Then, open up the table again, go to the record, and check to see if any of the values changed.
If they did not, then I think there is no reason to cycle through all the records, as no changes are saved back to the original table.

 

[FryGirl]

Thanks Joe. I'll dig into it a little further.