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...
The difficult I do immediately, the impossible takes a little bit longer.
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.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
        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!
Tips (Main)
Creating a Multi-Value field using Alphabet
Copy Fields Down from above Record
Loop thru records and OutPutTo seperate .RTF or .PDF
Modified Spell Check
Code Snippets
Lock\Unlock Bound Controls
Create a Table with Dynamic Field Names
Snippets for Exporting to Excel
Log Field Changes
Log Record Deletions
Check for Duplicate Values
Selecting an Excel Worksheet from Access
Send eMail to Multiple Recipients
Cancel Save in a Bound Form
Automatically Send eMail Notifications
Looping Records to Send eMail
Check if Table Exists
Insert (or Remove) Blank Line
Click to send feedback...
This site uses cookies to collect data on usage. By continuing to browse this site you consent to this policy. Find out more here.