UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> ListNewRecord    


Synopsis

Use this procedure in the After Insert event to renumber records containing numbered/ordered lists upon adding a new record. It renumbers the lists in accordance with the values entered into the new record. It is useful for sort order, priorities, or other situations when records require consecutively numbered values. Order values that are Null or zero (0) are placed at the end of the relevant list. Order values less than zero (0) are placed at the beginning of the list. All other Order values are 'inserted' into the list in the indicated location, while the other records are renumbered to prevent duplicate values. Related procedures are ListRenumber, ListDeleteRecord, ListInitialize, and ListFindFormTable. The ListFindFormTable is required.

NOTES: (1) Arguments are Control Names. The Control Source of those controls must refer to actual field names (no aliases). (2) Uses of this function include priority lists, and user defined sort order.

CODE
' ListNewRecord
' http://www.utteraccess.com/wiki/ListNewRecord
' 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 upon adding a new record
'  Procedure Arguments:
'           Key:  Control containing the Primary Key
'     PairNames:  Parameter array listing control names.  These names
'              must be in pairs for controls governing Field to be renumbered
'              and Criteria Field giving the list to be renumbered, e.g.
'              ** Me.MainList.Name, "", Me.OrgList.Name, Me.OrgID.Name **
'              adjust a main/overall list for the table, and adjust
'              an Organization List for the Organization identified in OrgID
'              (Allows multiple 1-n lists to be maintained in the same record)
'  Notes:
'     Requires utility function ListFindFormTable
'     Use this procedure in form After Insert events
'     Records are renumbered to accomodate the input list values
'     Input list values of Null or Zero (0) are placed at the end of the list
'     Input list values less than zero are placed at beginning of list
Public Sub ListNewRecord(Key As String, ParamArray PairNames() As Variant)
  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, lCat As Long, lMax As Long
  Dim bChange As Boolean, sql As String
  Dim msg As String, i As Long
On Error GoTo Hndlr
  Set frm = Application.CodeContextObject
  sTable = "[" & ListFindFormTable(frm) & "]"
  If InStr(1, sTable, "SELECT ") > 0 Then
     MsgBox "Record Source for Form " & frm.Name & " must be a table.", vbCritical
     frm.Undo
     End   'stop code execution
  End If
  'verify PairNames exist in correct numbrs
  Select Case UBound(PairNames)
     Case 0, -1   '0=> only 1 parameter entered, -1 => no parameters entered
        msg = "At least 2 PairNames are required." & vbCr & _
           "The second may be an empty string ("""")."
     Case Else   ' more than 1 arg entered, but even number?
        If (UBound(PairNames) + 1 Mod 2) = 0 Then
           'odd number entered, must be even number
           msg = "The number of PairNames must be even."
        End If
  End Select
  If Len(msg) > 0 Then
     MsgBox msg, vbCritical
     End   'stop exection
  End If
  'PK same for all lists
  With frm.Controls(Key)
     sKey = "[" & .ControlSource & "]=" & .Value
  End With
  'renumber each list in order
  For i = 0 To UBound(PairNames) Step 2
     If Len(PairNames(i + 1)) > 0 Then
        'criteria provided, account for it
        With frm.Controls(PairNames(i + 1))
           sCrit = " AND [" & .ControlSource & "]=" & .Value
        End With
     Else
        sCrit = ""
     End If
     With frm.Controls(PairNames(i))
        sOrder = .ControlSource
        lMax = DMax(sOrder, sTable, Mid(sCrit, 6)) + 1  'technically, the new record
        lNew = Nz(.Value, 0)
        Select Case lNew
           Case Is < 0
              lNew = 1
           Case 0, Is > lMax
              lNew = lMax
           'case else do nothing
        End Select
        lOld = lMax 'technical it's Null (No previous values)
     End With
     If lNew < lMax Then
        'record inserted with order lNew,
        'move other records further down 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
     'now change the current list item
     sql = "UPDATE " & sTable & " SET [" & sOrder & "]=" & lNew & _
           " WHERE " & sKey
     CurrentDb.Execute sql
  Next
  frm.Requery
  frm.Recordset.FindFirst sKey
  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 ListNewRecordC" & _
     vbCr & msg
End Sub

Creative Commons License
ListNewRecord 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 2,418 times.  This page was last modified 11:21, 14 October 2015 by azolder.   Disclaimers