Access Diva Loop while renumbering two columns

Loop While Renumbering Two Columns...

This is an oldie but a goody... I needed to loop thru a Recordset after the slides had been added and make sure there were only 140 slides per tray AND make sure they were in sequential order AND I could change the TrayID or the PositionID at any time and still have it reorder...

Private Sub cmdReorganize_Click()
 
    Dim Slide As Database
    Dim Present As Recordset
    Dim ITray As Integer, IPosit As Integer, IMax As Integer
 
    Set Slide = CurrentDb
    Set Present = Slide.OpenRecordset("qryPresentationAddEdit", dbOpenDynaset)
 
    If Not IsNull(Me.txtImageID) Then
 
    IMax = 140                      'Set Maximum number for Tray Position
 
    Requery                         'Refreshes screen
    Present.Requery                 'Sorts to ensure first record is lowest value of tray, position
    Present.MoveFirst               'Ensures we start at first record
 
    ITray = Present![txtTrayID]    'Init Tray counter to value in first record
    IPosit = 1                      'forces position 1
 
    Do Until Present.EOF            'loop through to End Of File
 
        If IPosit > IMax Then       'Last one updated was at maximum or last position
            IPosit = 1              'Reset
            ITray = ITray + 1       'Increment Tray
        End If
 
        If ITray < Present![txtTrayID] Then   'Changed tray number, continue numbering from 1 of next tray
            IPosit = 1    'Reset
            ITray = Present![txtTrayID]       'Set Tray
        End If
 
        Present.Edit                       'Enable updating
        Present![txtPositionID] = IPosit        'Set new Position in Tray
        Present![txtTrayIDr] = ITray       'Set new Tray
        Present![chkPositionFlag] = 0         'Set Position Flag to OFF
        Present.Update
        Present.MoveNext                   'Move to next record
 
        IPosit = IPosit + 1                'Increment Position in Tray
 
    Loop                                   'end of EOF do loop
 
    Present.Requery                        'Sort records into new order
    Requery                                'Refreshes screen
    DoCmd.GoToRecord , , acNext            'Moves to the next record
 
    Present.Close                          'qryPresentationAddEdit
    Else
        MsgBox "Please look up a Presentation!", vbExclamation
    End If
 
End Sub

Once all the Images for the Presentation had been selected all I had to do was click the Reorganize button (above). If you look at the example (purple circle) some changed to Tray 2 and the PositionID has been adjusted because the limit of 140 slides in Tray 1 had been reached.

Below is the code behind the Reorganize button, have fun!