Sort function in ADODB RecordSet not working correctly

Question

I am trying to develop an app for a club in Excel and in registering members for a day I have developed a UserForm with two ListBoxes, the first containing all members and the second with members for the day.

The second ListBox adds the members into playing groups so the order of members is important. To be flexible, the order of members needs to able to changed, so the order that people arrive is not necessarily which group they will end up in.

I have written the app using two ADODB RecordSets behind the ListBoxes, and this where the main work about ordering the players occurs. Should be simple! However if the order of players is altered often enough, the .Sort fails to be applied and .MoveNext seems to move not to the next sorted value, but to the next value as if no sort had been applied.

I have written a small program which demonstrates this perplexing behaviour.

Option Explicit
Dim rs As ADODB.Recordset
Sub demo()
Set rs = New ADODB.Recordset
Dim i As Long
Dim num As Long
With rs
   .Fields.Append "number", adInteger
   .Fields.Append "Name", adVarWChar, 1
   .Open
   
   For i = 1 To 6
      .AddNew Array("number", "name"), Array(i, Chr(64 + i))
   Next
   
   .MoveFirst
   Debug.Print .GetString
   moveup "d", 2
   .MoveFirst
   Debug.Print .GetString
   .Sort = "Number"
   .MoveFirst
   .Find "name='" & "f" & "'"
   !Number = !Number + 1
   .MoveNext
   !Number = !Number - 1
   .Sort = "number"
   .MoveFirst
   Debug.Print .GetString
   .Close
End With
Set rs = Nothing
End Sub

Sub moveup(c As String, step As Long)

With rs
   .MoveFirst
   .Find "name='" & c & "'"
   !Number = !Number + step
   .Move step
   !Number = !Number - step
   .Sort = "Number"
End With
End Sub

In this example you can see that the Debug.Print gives the following output

1  A
2  B
3  C
4  D
5  E
6  F

1  A
2  B
3  C
4  F
5  E
6  D

1  A
2  B
3  C
5  D
5  E
5  F

So the final .MoveNext moves from record 4 to record 6.

I have overcome it (I think) by not relying on .MoveNext, but by using .Find again for the next listed player in the ListBox and then having a routine that goes down the ListBox entries and checks that the numbering in the RecordSet is correct.

Has anyone else experienced this behaviour in RecordSets? Is there a way to overcome the issue? Is there a better way to organise the data rather than in a RecordSet?

Update:

I have found that I can save the recordset to a stream, then close and reopen the recordset loading the stream. This seems to reset the index so it behaves properly. the code I used was as follows:

Sub reopenrs()

Dim strm As New ADODB.Stream
rs.Save strm
rs.Close
rs.Open strm
strm.Close
Set strm = Nothing

End Sub

I called this sub in the main routine after the 'moveup 2 ' call.

So although the problem still remains this looks like an acceptable work around for me

Answer 1

"Is there a better way to organise the data rather than in a RecordSet?" - yes! it's Excel itself. Since your data is not in a database, you don't need to use Recordset to perform any task since all tasks can be solved in Excel.

Just put data on a worksheet and you can manipulate them the way you need including sort, find, and other operations.

Answer 2

If you set a Watch expression of rs.AbsolutePosition and then step through your code, you should see that the final instance of MoveNext causes an increment of only 1 - the "increase" of 2 that you observe is because the preceding line

   !Number = !Number + 1

also caused an increment of 1.

The effect of editing a record - essentially a change to its sort key - is that it effectively changes position within the RecordSet to align with the previously imposed sort order. This can be seen clearly in the differences between edits effected in moveup() vs those in demo() - when moveup() has been called, no sort order has yet been imposed, so the edits therein, even though they change sort keys, do not cause any records to change position; when edits are effected in demo(), however, it is after a sort has been imposed, with the result that those edits cause the records themselves to change position.

For the purposes of your illustration of the problem, the issue can be overcome by using a Bookmark

Option Explicit
Dim rs As ADODB.Recordset
Sub demo()
Set rs = New ADODB.Recordset
Dim i As Long, current
Dim num As Long
With rs
   .Fields.Append "Number", adInteger
   .Fields.Append "Name", adVarWChar, 1
   .Open
   
   For i = 1 To 6
      .AddNew Array(0, 1), Array(i, Chr(64 + i))
   Next
   
   .MoveFirst
   Debug.Print .GetString
   moveup "D", 2
   .MoveFirst
   Debug.Print .GetString
   .Sort = .Fields(0).Name
   .MoveFirst
   .Find "Name='F'"
   .MoveNext
   current = .Bookmark
   MovePrevious
   .Fields(0) = .Fields(0) + 1
   .Bookmark = current
   .Fields(0) = .Fields(0) - 1
   .Sort = .Fields(0).Name
   .MoveFirst
   Debug.Print .GetString
   .Close
End With
Set rs = Nothing
End Sub

Sub moveup(c As String, step As Long)
With rs
   .MoveFirst
   .Find "Name='" & c & "'"
   .Fields(0) = .Fields(0) + step
   .Move step
   .Fields(0) = .Fields(0) - step
   .Sort = .Fields(0).Name
End With
End Sub

but, whether that will help with your actual use case remains to be seen.

Answer 3

Another take:

Dim rs As ADODB.Recordset

Sub demo()
    Set rs = New ADODB.Recordset
    Dim i As Long
    Dim num As Long
    With rs
       .Fields.Append "number", adInteger
       .Fields.Append "Name", adVarWChar, 1
       .Fields.Append "Address", adVarWChar, 20
       .Open
       
       For i = 1 To 6
          .AddNew Array("number", "name", "Address"), _
                  Array(i, Chr(64 + i), "Address " & Chr(64 + i))
       Next
       
       .MoveFirst
       Debug.Print .GetString
       
       SwapRecords "name", "d", 2, "number"
       .MoveFirst
       Debug.Print .GetString
       
       SwapRecords "name", "b", -1, "number"
       .MoveFirst
       Debug.Print .GetString
       
       .Close
    End With
    Set rs = Nothing
End Sub

'Find a record in `rs` where Field `fldFind` = `valFind` and swap that record with
'  the record `step` records beyond.  Do not swap field values for field `fldIndex`
Sub SwapRecords(fldFind As String, valFind As String, step As Long, fldIndex As String)
    Dim rec1, rec2, bm
    With rs
       .MoveFirst
       .Find fldFind & "='" & valFind & "'"
       bm = .Bookmark       'mark the record
       rec1 = rs.GetRows(1) 'read the values
       .Bookmark = bm       'return to the record (getRows advances the cursor)
       .Move step
       bm = .Bookmark
       rec2 = rs.GetRows(1)
       .Bookmark = bm
       Fill rs, rec1, fldIndex  'replace with first record's values
       .Move -step
       Fill rs, rec2, fldIndex  'replace with second record's values
    End With
End Sub

'populate current record in `rs` with values from `rec`, except for
'   field named `skipField`
Sub Fill(rs, rec, skipField As String)
    Dim i As Long
    For i = LBound(rec, 1) To UBound(rec, 1)
        With rs.Fields(i)
            If .Name <> skipField Then .Value = rec(i, 0)
        End With
    Next i
End Sub

output:

1   A   Address A
2   B   Address B
3   C   Address C
4   D   Address D
5   E   Address E
6   F   Address F

1   A   Address A
2   B   Address B
3   C   Address C
4   F   Address F
5   E   Address E
6   D   Address D

1   B   Address B
2   A   Address A
3   C   Address C
4   F   Address F
5   E   Address E
6   D   Address D

Note if you swap the full records then you don't even need to re-sort, so perhaps you don't need the Number field.