Using buttons to change sort order

[Seth Schrock]

Introduction

There have been a few times recently that I have had to make it so that users could easily change the order of records. This comes in handy when planning tasks and you don't necessarily enter them in the correct order. So instead of just having the user have to manually change the numbers in the sort field, I created four buttons: Move First, Move Up, Move Down, and Move Last. Originally, I had created a separate procedure to take care of each of these moves. I also had it fairly locked down in that each procedure would only work on that one recordset. This part wasn't a big deal when I only had one set of buttons in the database. Now, I have a database where I will have multiple sets, so I decided that I needed to make my procedures more flexible. So this is what I have come up with.


Solution
First some setup information. For simplicity sake, I'll make the table that stores the sorted data have only three fields and have it setup like this:

tblSortedData
DataID, PK, AutoNumber
Description, Text
DataOrder, Number(Integer)

Now, I like basing my forms on queries instead of the table directly as this allows me to reference fields that aren't included in my form, so I have created a query that just selects everything from tblSortedData and I will call it qrySortedData.
Now this data will be viewed in a subform called sfrmSortedData and it has the following controls:

Control Name     Control Source
txtDescription   Description
txtDataOrder     DataOrder

This subform will be on a main form called frmMain and it will have a subform control titled the same as the subform name (sfrmSortedData) and four buttons: cmdMoveFirst, cmdMoveUp, cmdMoveDown, and cmdMoveLast. That should get us ready for the code.

I am including my error handling that calls a separate function, but not the separate function itself. If you want to see it, I can post it later.

First, I created an enum to make it easier to work with the different directions and put it in my utilities module (modUtilities).

Public Enum eMoveDirection
    ssFirst = 1
    ssUp = 2
    ssDown = 3
    ssLast = 4
End Enum

Now I will make the sub that will actually do the changing of the sort values. To start with, here is the empty shell of the sub including all the declarations of the variables:

Public Sub ChangeOrder(Move As Integer, ByVal CurrentOrder As Integer, _
                            Query As String, SortField As String)
On Error GoTo Error_Handler
 
Dim db As DAO.Database
Dim strDMax As String
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim NewValue As Integer
Dim strCriteria1 As String
Dim strCriteria2 As String
Dim i As Integer
 
 
 
 
 
Exit_Procedure:
    On Error Resume Next
 
    rst.Close
    rst1.Close
    rst2.Close
 
    Set db = Nothing
    Set rst = Nothing
    Set rst1 = Nothing
    Set rst2 = Nothing
 
    Exit Sub
 
Error_Handler:
    Call ErrorMessage(Err.Number, Err.Description, "modUtilities: ChangeOrder")
    Resume Exit_Procedure
    Resume
 
End Sub

First, let me explain the arguments of the procedure.

Move: This tells the procedure which move action will be performed
CurrentOrder: This passes the current value of the sort field
Query: This passes the SQL string that will allow the procedure to open the recordset for the particular set of buttons that is being operated.
SortField: This passes the name of the field that is being used to sort the data.

I will explain most of the other variables as they come up, but I will explain the rst, rst1, rst2, strCriteria1, and strCriteria2. rst contains all the records that are being sorted. rst1 will only ever hold the record that is the current record that the user is trying to move. strCriteria1 will hold the information needed to get that record out of rst. rst2 is similar, but it holds all the records that will have to be moved around in order for the selected record to end up where it needs to go. Likewise, strCriteria2 holds the string information to get the needed records from rst.

Now we will open the rst recordset:

Set db = CurrentDb
Set rst = db.OpenRecordset(Query, dbOpenDynaset)

Now we will get the new value and set strCriteria1 and strCriteria2 using a Select Case statement.

strCriteria1 = SortField & " = " & CurrentOrder
 
Select Case Move
    Case ssUp
        NewValue = CurrentOrder - 1
        strCriteria2 = SortField & " = " & NewValue
 
    Case ssDown
        NewValue = CurrentOrder + 1
        strCriteria2 = SortField & " = " & NewValue
 
    Case ssFirst
        NewValue = 1
        strCriteria2 = SortField & " < " & CurrentOrder
 
    Case ssLast
        strDMax = "SELECT TOP 1 " & Mid(Query, 8) & " ORDER BY " & SortField & " DESC"
 
        Set rst2 = db.OpenRecordset(strDMax, dbOpenDynaset)
 
        With rst2
            NewValue = .Fields(SortField)
            .Close
            Set rst2 = Nothing
        End With
 
        strCriteria2 = SortField & " > " & CurrentOrder
 
End Select

So we are testing for which move is needed. Note: each procedure calling this sub has already tested that the current record isn't the first record for ssUp and ssFirst and that it isn't the last record when calling ssDown and ssLast. strCriteria1 always only selects the record that is currently selected. So, if we are trying to move the record up in the order, NewValue will be one less than the current value. And since we are only moving the selected record up one space, there is only one record that has to move in response and that is the record that currently holds the value that is equal to the new value. Thus we have lines 5 & 6. The same basic principle is true for ssDown, except that the NewValue will be one greater than the current value.
For ssFirst, NewValue is automatically 1 as that is the highest priority value possible. strCriteria2 becomes all records whose sort order is less than the current order value (this includes the record that is currently number one).
If we are trying to move to the last record, we first have to determine what that is as there could be 10 records or there could be 50. So, since the domain function DMax doesn't support variables in the Domain Name slot, I used my old trick of using a "SELECT TOP 1" query to get the value and then I assign this to NewValue. strCriteria2 becomes all records that have a order value higher (lower ranked) values than the current record.

Now we can use strCriteria1 and strCriteria2 to filter rst to come up with rst1 and rst2.

rst.Filter = strCriteria1
Set rst1 = rst.OpenRecordset
 
rst.Filter = strCriteria2
Set rst2 = rst.OpenRecordset

Now for the magic that actually changes the values.

'Non current records
With rst2
    .MoveLast
    .MoveFirst
 
    If .RecordCount > 1 Then
 
        'MoveLast or MoveFirst
        If NewValue > CurrentOrder Then
 
            'MoveLast
            For i = CurrentOrder To (NewValue - 1)
                .Edit
                .Fields(SortField) = i
                .Update
                .MoveNext
            Next i
 
        Else
 
            'MoveFirst
            For i = NewValue To (CurrentOrder - 1)
                .Edit
                .Fields(SortField) = i + 1
                .Update
                .MoveNext
            Next i
 
        End If
 
    Else
 
        'MoveUp and MoveDown
        .Edit
        .Fields(SortField) = CurrentOrder
        .Update
 
    End If
 
End With
 
'Current record
With rst1
    .Edit
    .Fields(SortField) = NewValue
    .Update
End With

I start with the non current records. First I have to do a .MoveLast/.MoveFirst so that I get a correct record count. I then test to see if there is more than one record. If there is, then the move is either a move first or move last. If there isn't, then it was either a move up or move down (which would behave the exact same way). So, starting with .RecordCount > 1 = True... We then test to see if it was move last or move first that was called. I won't actually do the math for you as it would take a lot more explanation in an already large article, so I'll just leave it at "it works correctly".
If .RecordCount was equal to 1, then it is a simple setting of the record to the CurrentOrder which is now the old value.
Also easy is the setting of the current record to the new value as seen in lines 42 - 47. That finishes the procedure. Here it is in its entirety.

Public Sub ChangeOrder(Move As Integer, CurrentOrder As Integer, _
                            Query As String, SortField As String)
On Error GoTo Error_Handler
 
Dim db As DAO.Database
Dim strDMax As String
Dim rst As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim NewValue As Integer
Dim strCriteria1 As String
Dim strCriteria2 As String
Dim i As Integer
 
 
Set db = CurrentDb
Set rst = db.OpenRecordset(Query, dbOpenDynaset)
 
strCriteria1 = SortField & " = " & CurrentOrder
 
Select Case Move
    Case ssUp
        NewValue = CurrentOrder - 1
        strCriteria2 = SortField & " = " & NewValue
 
    Case ssDown
        NewValue = CurrentOrder + 1
        strCriteria2 = SortField & " = " & NewValue
 
    Case ssFirst
        NewValue = 1
        strCriteria2 = SortField & " < " & CurrentOrder
 
    Case ssLast
        strDMax = "SELECT TOP 1 " & Mid(Query, 8) & " ORDER BY " & SortField & " DESC"
 
        Set rst2 = db.OpenRecordset(strDMax, dbOpenDynaset)
 
        With rst2
            NewValue = .Fields(SortField)
            .Close
            Set rst2 = Nothing
        End With
 
        strCriteria2 = SortField & " > " & CurrentOrder
 
End Select
 
 
 
rst.Filter = strCriteria1
Set rst1 = rst.OpenRecordset
 
rst.Filter = strCriteria2
Set rst2 = rst.OpenRecordset
 
'Non current records
With rst2
    .MoveLast
    .MoveFirst
 
    If .RecordCount > 1 Then
 
        'MoveLast or MoveFirst
        If NewValue > CurrentOrder Then
 
            'MoveLast
            For i = CurrentOrder To (NewValue - 1)
                .Edit
                .Fields(SortField) = i
                .Update
                .MoveNext
            Next i
 
        Else
 
            'MoveFirst
            For i = NewValue To (CurrentOrder - 1)
                .Edit
                .Fields(SortField) = i + 1
                .Update
                .MoveNext
            Next i
 
        End If
 
    Else
 
        'MoveUp and MoveDown
        .Edit
        .Fields(SortField) = CurrentOrder
        .Update
 
    End If
 
End With
 
'Current record
With rst1
    .Edit
    .Fields(SortField) = NewValue
    .Update
End With
 
 
Exit_Procedure:
    On Error Resume Next
 
    rst.Close
    rst1.Close
    rst2.Close
 
    Set db = Nothing
    Set rst = Nothing
    Set rst1 = Nothing
    Set rst2 = Nothing
 
    Exit Sub
 
Error_Handler:
    Call ErrorMessage(Err.Number, Err.Description, "modUtilities: ChangeOrder")
    Resume Exit_Procedure
    Resume
 
End Sub

Now for the procedures that call it. They are mostly self explanatory, so I won't go into great detail. Here is the procedure for cmdMoveLast's OnClick event:

Dim strQuery As String
Dim lngRecord As Long
 
strQuery = "SELECT * FROM tblSortedData"
 
With Me.sfrmSortedData.Form   
 
    lngRecord = !DataID
 
    If Not .Recordset.RecordCount = .CurrentRecord Then
        ChangeOrder ssLast, .Recordset!DataOrder, strQuery, "DataOrder"
    Else
        MsgBox "You cannot move this record higher in the sort order."    
    End If
 
    Me.sfrmSortedData.Requery
    .Recordset.FindFirst "DataOrder = " & lngRecord
End With

strQuery is the query string that gets passed to the ChangeOrder procedure. Line 17 makes the record that just got moved be the selected record. Without it, if you did a move up on the second record, the second record would remain highlighted. It would just be a different record than the one you clicked originally. The same applies to any other move. The procedure for cmdMoveDown is the same except that you would need to change the first argument to ssDown. The procedures for cmdMoveFirst and cmdMoveUp are

Dim strQuery As String
Dim lngRecord As Long
 
strQuery = "SELECT * FROM tblQuestionLevel " & _
           "WHERE PenalCodeID_fk = " & Me.OpenArgs
 
With Me.frmDT_Stage2.Form
 
    lngRecord = !LevelID
 
    If Not .CurrentRecord = 1 Then
        ChangeOrder ssFirst, .Recordset!QLOrder, strQuery, "QLOrder"
    Else
        MsgBox "You cannot move this record higher in the sort order."
    End If
 
    Me.frmDT_Stage2.Requery
    .Recordset.FindFirst "LevelID = " & lngRecord
End With

All that needs to change is the ssFirst to ssUp. The main difference between these procedures (other than the move direction) is the record testing.



Solution

I have here a procedure that allows all the move directions in the same procedure and it isn't tied to one set of buttons, so it is very reusable. This allows for easy reordering of records by users without the risk for values to be duplicated or skipped.

Please let me know if you have a better way, have spotted an error, or that it has helped you. Comments of any sort are very welcome.