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.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!
VBA
Tips (Main)
Home
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
ValidateData()
ClearClipboard()
Selecting an Excel Worksheet from Access
Send eMail to Multiple Recipients
Cancel Save in a Bound Form
Automatically Send eMail Notifications
fFindBookmark()
Looping Records to Send eMail
fxlFindReplace()
fMouseOverCurrent()
fHighlightRequiredControls()
Check if Table Exists
fAmortization()
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.