How do I use For Next loop to update column in Table Access 2007 VBA

Question

I have 13 records today (current Fiscal Year), (it could be 25 tomorrow) in a table.

The field is a number field and is not a primary key. The first record is a 1. They are in date order so Record 1 will always be 1.

The field removes a number every time a certain box is checked on a form. This means the case did not develop (yet). I would like to renumber the other records.

The numbers are used for the Case Number (different Field) (uses number and letters).

The user wants the rest of the case numbers renumbered when a case is removed due to lack of development. I just need the field renumbered. I have other code to change the Case Numbers once the field is renumbered.

As you can see, the Case Number for record number 7 was removed because it did not develop.

I have been manually changing the numbers because there are only 13 records. But by the end of the Fiscal Year, we may have 300+.

• Form = Frm_Current
• Table = Tbl_Data
• Field = RecID2 (a number field) (not a Primary Key Field)

This is what I have now:

Record1 =  1
Record4 =  2
Record5 =  3
Record7 =      
Record8 =  5
Record9 =  6
Record12 = 7 
Record13 = 8

This is what I would like to see:

Record1 =  1
Record4 =  2
Record5 =  3
Record8 =  4
Record9 =  5
Record12 =  6
Record13 =  7

I have code like this but of course it is not working.

Dim strSQL As String
Dim rs As DAO.Recordset
Dim Rec2Num As Integer
Dim Rec3Num As Integer
Dim EOR As Integer
strSQL = "Tbl_Data"
Set rs = CurrentDb.OpenRecordset(strSQL)
Rec3Num = rs.Fields("RecID2")
For Rec2Num = 0 To EOR
if Rec3Num = 1 Then
Rec3Num = Rec2Num + 1
End If
Next

Any help would be greatly appreciated.

Answer 1

This seems like really bad practice; a better approach would be to retain the original record numbering and assign a new ID to 'developed cases' .

Nevertheless, assuming the above approach is not an option, the key is to ensure that you are working with an ordered dataset (since, by default, MS Access works with unordered datasets whereby you cannot guarantee the order in which the records will be accessed).

Therefore, your code should look something like the following:

Function RenumberField()
    Dim id As Long
    With CurrentDb.OpenRecordset("select recid2 from Tbl_Data where recid2 is not null order by recid2")
        If Not .EOF Then
            .MoveFirst
            Do Until .EOF
                id = id + 1
                .Edit
                !recid2 = id
                .Update
                .MoveNext
            Loop
        End If
        .Close
    End With
End Function

Answer 2

This is what in other scenarios is called priority numbering .

I did a function for this that takes the textbox holding this number as argument:

' Set the priority order of a record relative to the other records of a form.
'
' The table/query bound to the form must have an updatable numeric field for
' storing the priority of the record. Default value of this should be Null.
'
' Requires:
'   A numeric, primary key, typical an AutoNumber field.
'
' 2018-08-31. Gustav Brock, Cactus Data ApS, CPH.
'
Public Sub RowPriority( _
    ByRef TextBox As Access.TextBox, _
    Optional ByVal IdControlName As String = "Id")

    ' Error codes.
    ' This action is not supported in transactions.
    Const NotSupported      As Long = 3246
    Dim Form                As Access.Form
    Dim Records             As DAO.Recordset

    Dim RecordId            As Long
    Dim NewPriority         As Long
    Dim PriorityFix         As Long
    Dim FieldName           As String
    Dim IdFieldName         As String

    Dim Prompt              As String
    Dim Buttons             As VbMsgBoxStyle
    Dim Title               As String

    On Error GoTo Err_RowPriority

    Set Form = TextBox.Parent

    If Form.NewRecord Then
        ' Will happen if the last record of the form is deleted.
        Exit Sub
    Else
        ' Save record.
        Form.Dirty = False
    End If

    ' Priority control can have any Name.
    FieldName = TextBox.ControlSource
    ' Id (primary key) control can have any name.
    IdFieldName = Form.Controls(IdControlName).ControlSource

    ' Prepare form.
    DoCmd.Hourglass True
    Form.Repaint
    Form.Painting = False

    ' Current Id and priority.
    RecordId = Form.Controls(IdControlName).Value
    PriorityFix = Nz(TextBox.Value, 0)
    If PriorityFix <= 0 Then
        PriorityFix = 1
        TextBox.Value = PriorityFix
        Form.Dirty = False
    End If

    ' Disable a filter.
    ' If a filter is applied, only the filtered records
    ' will be reordered, and duplicates might be created.
    Form.FilterOn = False

    ' Rebuild priority list.
    Set Records = Form.RecordsetClone
    Records.MoveFirst
    While Not Records.EOF
        If Records.Fields(IdFieldName).Value <> RecordId Then
            NewPriority = NewPriority + 1
            If NewPriority = PriorityFix Then
                ' Move this record to next lower priority.
                NewPriority = NewPriority + 1
            End If
            If Nz(Records.Fields(FieldName).Value, 0) = NewPriority Then
                ' Priority hasn't changed for this record.
            Else
                ' Assign new priority.
                Records.Edit
                    Records.Fields(FieldName).Value = NewPriority
                Records.Update
            End If
        End If
        Records.MoveNext
    Wend

    ' Reorder form and relocate record position.
    ' Will fail if more than one record is pasted in.
    Form.Requery
    Set Records = Form.RecordsetClone
    Records.FindFirst "[" & IdFieldName & "] = " & RecordId & ""
    Form.Bookmark = Records.Bookmark

PreExit_RowPriority:
    ' Enable a filter.
    Form.FilterOn = True
    ' Present form.
    Form.Painting = True
    DoCmd.Hourglass False

    Set Records = Nothing
    Set Form = Nothing

Exit_RowPriority:
    Exit Sub

Err_RowPriority:
    Select Case Err.Number
        Case NotSupported
            ' Will happen if more than one record is pasted in.
            Resume PreExit_RowPriority
        Case Else
            ' Unexpected error.
            Prompt = "Error " & Err.Number & ": " & Err.Description
            Buttons = vbCritical + vbOKOnly
            Title = Form.Name
            MsgBox Prompt, Buttons, Title

            ' Restore form.
            Form.Painting = True
            DoCmd.Hourglass False
            Resume Exit_RowPriority
    End Select

End Sub

Full documentation and a demo can be found here: Sequential Rows in Microsoft Access

Browser for paragraph 3. Priority Numbers

(If you don't have an account, browse for the link: Read the full article.

Current code is always on GitHub : VBA.RowNumbers