UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> ListRenumber    


Synopsis

Use this procedure to renumber ordered list fields in a table. It is useful for sort order, priorities, or other situations when records require consecutively numbered values. Related procedures in this library are ListDeleteRecord, ListNewRecord, ListFindFormTable and ListInitialize. The ListFindFormTable is required.

NOTE: Arguments are Control Names. The Control Source of those controls must refer to actual field names (no aliases).

CODE
' ListRenumber
' http://www.utteraccess.com/wiki/ListRenumber
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.0  2015-09-23                    
'
'*******************************************************************
'  Procedure to Renumber Lists based on Updated values
'  Function Arguments:
'     Order:  Control Name containing the numbered/ordered list
'       Key:  Control  Name containing the Primary Key
'      Crit:  Optional control name containing criteria for list being numbered.
'        Leave empty if entire table is being numbered
'        (Allows multiple 1-n lists to be maintained in the same record)
'  Function Returns:
'     True if Renumbering successful
'     False otherwise
'  Notes:
'     Requires utility function ListFindFormTable
'     Only one list at a time
'     When renumbering, records with Null or zero 'Order' fields are ignored
'     This procedure takes NO action on new records.  (All of the required data
'        may be missing.)  Use the ListNewRecord procedure in the After Insert
'        event to renumber the records accordingly.
'     Processing aborts/ends execution if the RecordSource does not give a unique table
'     Use this procedure in AfterUpdate events of the 'Order' field
Public Sub ListRenumber(Order As String, Key As String, Optional Crit As String = "")
  Dim frm As Form
  Dim sTable As String, sOrder As String, sKey As String, sCrit As String
  Dim lNew As Long, lOld As Long, lKey As Long, lMax As Long
  Dim bChange As Boolean, sql As String, msg As String
  On Error GoTo Hndlr
  'identify calling form/object
  Set frm = Application.CodeContextObject
  'ignore for new records, New Records do not necessarily have all
  'of the required data
  If frm.NewRecord Then Exit Sub
  'assign variables and validate
  sTable = "[" & ListFindFormTable(frm) & "]"
  With frm.Controls(Order)
     sOrder = .ControlSource
     lNew = Nz(.Value, 0)
     lOld = Nz(.OldValue, 0) 'zero if null (no previous assignment)
  End With
  With frm.Controls(Key)
     sKey = .ControlSource
     lKey = .Value
  End With
  sCrit = " AND Nz([" & sOrder & "],0)>0"   'ignores records where sOrder is null
  If Len(Crit) > 0 Then
     With frm.Controls(Crit)
        sCrit = sCrit & " AND [" & .ControlSource & "]=" & Nz(.Value, 0)
     End With
  End If
  lMax = DMax(sOrder, sTable, Mid(sCrit, 6))
  If lOld = 0 Then lOld = lMax + 1 'ie assume bottom of list
  If lNew < 1 Then
     bChange = True
     lNew = 1
  ElseIf lNew > lMax Then
     bChange = True 'need to change the sOrder control
     lNew = lMax
  End If
  If lNew = lOld Then
     'no change
     Exit Sub
  ElseIf lNew > lOld Then
     'the record is moved further down the list, decrease those values by one
     sql = "UPDATE " & sTable & " SET [" & sOrder & "]=" & sOrder & "-1 " & _
        "WHERE [" & sOrder & "]>" & lOld & " AND [" & sOrder & "]<=" & _
        lNew & sCrit & ";"
  Else  'If lNew < lOld Then
     'the record is moved further up the list, increase those values by one
     sql = "UPDATE " & sTable & " SET [" & sOrder & "]=" & sOrder & "+1 " & _
        "WHERE [" & sOrder & "]>=" & lNew & " AND [" & sOrder & "]<" & _
        lOld & sCrit & ";"
  End If
  'change all records but the current record
  CurrentDb.Execute sql
  If bChange Then
     'assuming AfterUpdate, the input value, NewOrder is in error, Correct it
     frm.Dirty = False 'to avoid Write Conflict
     sql = "UPDATE " & sTable & " SET [" & sOrder & "]=" & lNew & _
        " WHERE [" & sKey & "]=" & lKey & ";"
     CurrentDb.Execute sql
  End If
  frm.Requery
  frm.Recordset.FindFirst "[" & sKey & "]=" & lKey
  Exit Sub
Hndlr:
  If Err.Number = 3061 Then
     msg = "Most likely caused by a ControlSource not being a valid field name."
  Else
     msg = "An unexpecte error occured."
  End If
  MsgBox Err.Number & " - " & Err.Description & " in ListRenumberC" & _
     vbCr & msg
End Sub

Creative Commons License
ListRenumber by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 983 times.  This page was last modified 14:14, 23 September 2015 by azolder.   Disclaimers