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:
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:
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).
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:
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:
Now we will get the new value and set strCriteria1 and strCriteria2 using a Select Case statement.
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.
Now for the magic that actually changes the values.
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.
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:
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
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.
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:
Code:
[U]tblSortedData[/U] DataID, PK, AutoNumber Description, Text DataOrder, Number(Integer)
Now this data will be viewed in a subform called sfrmSortedData and it has the following controls:
Code:
[U]Control Name Control Source[/U] txtDescription Description txtDataOrder DataOrder
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).
Code:
Public Enum eMoveDirection
ssFirst = 1
ssUp = 2
ssDown = 3
ssLast = 4
End Enum
Code:
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
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:
Code:
Set db = CurrentDb Set rst = db.OpenRecordset(Query, dbOpenDynaset)
Code:
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
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.
Code:
rst.Filter = strCriteria1 Set rst1 = rst.OpenRecordset rst.Filter = strCriteria2 Set rst2 = rst.OpenRecordset
Code:
'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
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.
Code:
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
Code:
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
Code:
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
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.