How do I set and manage query order priorities (1 Viewer)

[t00ley]

Hi All,

I have a Access 2013 database which imports a dataset from MS Excel, makes changes based on a set of rules (setup in another table and run via VBA using DAO recordsets), then exports the amended dataset. The rules need to be assigned a number for order of priority they are to be applied, which is done by the user via a form bound to the rules table.

How do I ensure that the order has no gaps or duplicates (except for 0)? Lets say I have 5 rules prioritised 1 to 5, then the user i.changes rule E to priority 2, then ii. deletes rule A (by setting priority to 0)...

The priority changes would be expected as follows:

Rule No. - Original Priority - After step i - After step ii
A.............1......................1..................0
B.............2......................3..................2
C.............3......................4..................3
D.............4......................5..................4
E.............5......................2..................1

FYI the form has a helper textbox, informing the user of the next available priority number (DMAX + 1 expression), and inputs the required priority number in another control which is bound to the table field. I understand this needs to be captured in the BeforeUpdate event for the bound control?

Can anyone help advise what the VBA should be to :

1. Validate the number input for new records is >= 0 and <= the Next Available Priority OR for existing records is >= 0 and < Next Available Priority
2. For new records, if the number input is > 0 and <= Next Available priority OR for existing records, if the number input is < Next Available priority then recalculate all existing priorities in the table that need to be changed

Thanks in advance

Tooley

 

[sneuberg]

Could you possibly handle this the way Access handled the tab sequences on a form in that new controls get the highest number and then you move them to where to want with Tab Order. I don't know if you could give the user a drag feature but I don't think it would be difficult to display these in a continuous form with Move Up/Move Down buttons.

 

[MarkK]

I too would give the user up/down buttons to click, and hide all the details about how the rows are actually ordered.

 

[Cronk]

Over time I've had several occasions where users wanted to be able to customize sort order. Add a field to the table called SortOrder, populate with ascending numbers and use buttons on a continuous form to swap the SortOrder number with the previous/next record depending on whether the up or down button is clicked.

I recently had a case where staff at different depots were to be printed in different orders. It was a bit further complicated because some staff worked out of multiple depots. Following is the up button code I used.

Private Sub cmdUp_Click()
   Dim db As Database, rst  As Recordset
   Dim lngPersonID As Long, lngSortOrder As Long, lngOldSortOrder As Long
   
   lngPersonID = Me.sfPersonnelSubForm.Form.PersonID
   lngOldSortOrder = Me.sfPersonnelSubForm.Form.SortOrder
   
   Set db = CurrentDb
   Set rst = db.OpenRecordset("SELECT TOP 2 tblPersonDepots.PersonID, tblPersonDepots.SortOrder FROM tblPersonnel INNER JOIN tblPersonDepots ON (tblPersonnel.PersonID = tblPersonDepots.PersonID) WHERE tblPersonnel.Active AND tblPersonDepots.SortOrder <=" & lngOldSortOrder & " AND tblPersonDepots.DepotID =" & Me.cboDepot & " ORDER BY tblPersonDepots.SortOrder DESC")
   
   rst.MoveFirst
   
   rst.MoveLast
   If rst.RecordCount < 2 Then
      '--First one already - do nothing
      GoTo cmdUp_Click_Exit
   End If
   
   lngSortOrder = rst!SortOrder
   rst.Edit
      rst!SortOrder = lngOldSortOrder
   rst.Update
   
   rst.MoveFirst
   rst.Edit
      rst!SortOrder = lngSortOrder
   rst.Update
      
   Me.sfPersonnelSubForm.Form.Requery
   
   Me.sfPersonnelSubForm.Form.RecordsetClone.FindFirst "PersonID=" & lngPersonID
   Me.sfPersonnelSubForm.Form.Bookmark = Me.sfPersonnelSubForm.Form.RecordsetClone.Bookmark
   
cmdUp_Click_Exit:
   On Error Resume Next
   rst.Close: Set rst = Nothing
   Set db = Nothing
   Exit Sub

cmdUp_Click_Error:
   Call RecordError("cmdUp_Click", Err, Error, Application.CurrentObjectName, True)
   Resume cmdUp_Click_Exit
   
End Sub

 

[t00ley]

Thanks all for the suggestion, which I've followed and used the code from Cronk which works exactly as I wanted. Much appreciated

 

[t00ley]

To assist others, my final code is below which does not involve sub forms:

CommandButton events:

Private Sub cmdPriorityOrderIncrease_Click()
    Call sPriorityOrderChange(True)
End Sub

Private Sub cmdPriorityOrderDecrease_Click()
    Call sPriorityOrderChange(False)
End Sub

Main procedure:

Private Sub sPriorityOrderChange(lbool_IncreasePriority As Boolean)
On Error GoTo Error_Handler
    Dim lobj_DB As Database, lobj_RS As Recordset
    Dim ll_PriorityOrder As Long, ll_OldPriorityOrder As Long, ll_RuleID As Long
    Dim ls_SQL As String, ls_Operator As String, ls_Sort As String, ls_Msg As String
    
    'Capture values from form record
    ll_RuleID = Me.txtRH_ID 'Unique Record ID
    ll_OldPriorityOrder = Me.txtPriorityOrder 'Current Priority setting
    
    'Determine variable parts of SQL code & error message based on boolean parameter
    Select Case lbool_IncreasePriority
        Case True
            ls_Operator = " <= "
            ls_Sort = " DESC"
            ls_Msg = "highest"
        Case False
            ls_Operator = ">="
            ls_Sort = vbNullString
            ls_Msg = "lowest"
    End Select
    
    'Build SQL
    ls_SQL = "SELECT TOP 2 [MyTable].[ID]" _
            & ", [MyTable].[PriorityOrder] " _
            & "FROM [MyTable] " _
            & "WHERE [MyTable].[PriorityOrder]" & ls_Operator & ll_OldPriorityOrder & " " _
            & "ORDER BY [MyTable].[PriorityOrder]" & ls_Sort
    
    Set lobj_DB = CurrentDb
    Set lobj_RS = lobj_DB.OpenRecordset(ls_SQL)
   
    With lobj_RS
        .MoveFirst
        .MoveLast
        If .RecordCount < 2 Then
            MsgBox "This Rule already has the " & ls_Msg & " priority setting!", vbInformation, UCase(ls_Msg) & " PRIORITY SETTING REACHED"
            .Close
            GoTo Exit_Handler
        End If
        
        'On 'other' record to swap PriorityOrder with (sorted FirstRecord = form record, LastRecord = other record)
        ll_PriorityOrder = !PriorityOrder                                                       'Capture the Priority setting
        .Edit
            !PriorityOrder = ll_OldPriorityOrder                                                'Updates Priority of 'other' record with that of the form record
        .Update
        'Move to form record
        .MoveFirst
        .Edit
            !PriorityOrder = ll_PriorityOrder                                                   'Updates Priority of form record with that of the 'other' record
        .Update
        .Close
    End With
       
    With Me
        .Requery
        .RecordsetClone.FindFirst "RH_ID=" & ll_RuleID
        .Bookmark = .RecordsetClone.Bookmark
    End With
        
Exit_Handler:
    If Not lobj_RS Is Nothing Then Set lobj_RS = Nothing
    If Not lobj_DB Is Nothing Then Set lobj_DB = Nothing
    Exit Sub
Error_Handler:
    Select Case Err.Number                                                                      
        Case Else
            Dim ls_ErrorDetails As String
            ls_ErrorDetails = "Error Number = " & Err.Number & vbNewLine _
                & "Description = " & Err.Description
            MsgBox gs_GenericErrMsg, vbCritical, gs_GenericErrTtl & ls_ErrorDetails
    End Select
    Resume Exit_Handler
End Sub