Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Renumbering a sequence on a form/table control

Status
Not open for further replies.

puforee

Technical User
Oct 6, 2006
741
US
I have a data base that stores questions. These are review questions for students. One of the fields in the Table and on the form is Print Order. My users need to be able to change the print order from the form and then renumber the rest of the items.

Example:
Print Order Change Question
1 A
2 B
3 1.5 C

After triggering Renumber

Print Order Change Question
1 A
2 C
3 B

Or something like this...I am sure there are more sofisicated methods.

Any Ideas?

Thanks,
 
I have some code that allows me to manually sort a form or sort a list box. The code is very resuseable and can be used with other interfaces. Just requires you to provide the field name on which to sort. This works really well for manually sorting large lists. Basically the code is the same for the two forms, but how you interface is different.

In the first form you click on the arrows next to the record to move it up or down. Or you can use up and down arrows within the field.
2vwb3ud.jpg

code in form
Code:
Private Sub Form_Load()
  SetInitialSort "JobStepNumber", Me
End Sub
Private Sub cmdDown_Click()
  MoveSortDown "JobStepNumber", Me
End Sub

Private Sub cmdListUp_Click()
 moveSortUp "JobStepNumber", Me
End Sub
Private Sub txtJobStep_KeyDown(KeyCode As Integer, Shift As Integer)
  If Shift = 0 And KeyCode = 38 Then
     moveSortUp "JobStepNumber", Me
  ElseIf Shift = 0 And KeyCode = 40 Then
    MoveSortDown "JobStepNumber", Me
  End If
End Sub

Reusable code in standard module, does not need editing. Will work with any form by providing the name of the sort field.
Code:
Public Sub SetInitialSort(SortField, frm)
  Dim rs As DAO.Recordset
  Set rs = frm.Recordset
  Do While Not rs.EOF
    rs.Edit
    rs.Fields(SortField) = rs.AbsolutePosition + 1
    rs.Update
    rs.MoveNext
  Loop
  rs.MoveFirst
End Sub
Public Sub moveSortUp(SortField, frm As Access.Form)
  Dim rsClone As DAO.Recordset
  Dim lngNewSort As Long
  Dim lngOldSort As Long
  Set rsClone = frm.RecordsetClone
  rsClone.AbsolutePosition = frm.Recordset.AbsolutePosition
  If Not (IsNull(rsClone.Fields(SortField)) Or rsClone.AbsolutePosition <= 0) Then
    lngOldSort = rsClone.Fields(SortField)
    lngNewSort = lngOldSort - 1
    rsClone.Edit
    rsClone.Fields(SortField) = lngNewSort
    rsClone.Update
    rsClone.MovePrevious
    rsClone.Edit
    rsClone.Fields(SortField) = lngOldSort
    rsClone.Update
  frm.Requery
  frm.Recordset.FindFirst SortField & " = " & lngNewSort
  End If
End Sub
Public Sub MoveSortDown(SortField, frm As Access.Form)
  Dim rsClone As DAO.Recordset
  Dim lngNewSort As Long
  Dim lngOldSort As Long
  Set rsClone = frm.RecordsetClone
  rsClone.AbsolutePosition = frm.Recordset.AbsolutePosition
  If Not (IsNull(rsClone.Fields(SortField)) Or rsClone.AbsolutePosition >= rsClone.RecordCount - 1) Then
    lngOldSort = rsClone.Fields(SortField)
    lngNewSort = lngOldSort + 1
    rsClone.Edit
    rsClone.Fields(SortField) = lngNewSort
    rsClone.Update
    rsClone.MoveNext
    rsClone.Edit
    rsClone.Fields(SortField) = lngOldSort
    rsClone.Update
  frm.Requery
  frm.Recordset.FindFirst SortField & " = " & lngNewSort
  End If
End Sub

The second example uses a listbox to sort. You move an item up and down in the list and it mirrors the form. In truth you do not need the records in the form you could do it all in the listbox. But it uses the index from the listbox to set the sort value of the records.

5a3ja9.jpg


code to sort a listbox
Code:
Public Sub convertToValueList(theListBox As Access.ListBox)
  'First column must be the PK
  Dim rs As DAO.Recordset
  Dim strSql As String
  Dim fldField As DAO.Field
  Dim strLstValue As String
  Dim intColCount As Integer
  Dim intColCounter As Integer
  Dim intRowCounter As Integer
  If theListBox.RowSourceType = "Table/Query" Then
    intColCount = theListBox.ColumnCount
    strSql = theListBox.RowSource
    theListBox.RowSource = ""
    Set rs = CurrentDb.OpenRecordset(strSql)
    theListBox.RowSourceType = "Value List"
    Do While Not rs.EOF
       For intColCounter = 0 To intColCount - 1
          strLstValue = strLstValue & """" & CStr(Nz(rs.Fields(intColCounter), " ")) & """;"
       Next intColCounter
       intRowCounter = intRowCounter + 1
       rs.MoveNext
       strLstValue = Left(strLstValue, Len(strLstValue) - 1)
       theListBox.AddItem (strLstValue)
       strLstValue = ""
    Loop
 End If
End Sub
Public Sub lstMoveUp(lstList As Access.ListBox)
  Dim itmIndex As Long
  Dim strItem As String
  itmIndex = lstList.ListIndex
  If itmIndex < 0 Then
    MsgBox "Select an item in the list"
  ElseIf itmIndex = 0 Then
    MsgBox "Beginning of List"
  Else
    strItem = getListString(lstList, itmIndex)
    lstList.RemoveItem itmIndex
    lstList.AddItem strItem, (itmIndex - 1)
  End If
End Sub
Public Sub lstMoveDown(lstList As Access.ListBox)
  Dim itmIndex As Long
  Dim strItem As String
  itmIndex = lstList.ListIndex
  If itmIndex < 0 Then
    MsgBox "Select an Item in the List"
  ElseIf itmIndex >= lstList.ListCount - 1 Then
    MsgBox "End of List"
  Else
    strItem = getListString(lstList, itmIndex)
    lstList.RemoveItem itmIndex
    lstList.AddItem strItem, (itmIndex + 1)
  End If
End Sub

Public Function getListString(lstList As Access.ListBox, itmIndex As Long) As String
   Dim columnCounter As Integer
   For columnCounter = 0 To lstList.ColumnCount - 1
       getListString = getListString & lstList.Column(columnCounter, itmIndex) & ";"
   Next columnCounter
   getListString = Left(getListString, Len(getListString) - 1)
   Debug.Print getListString
End Function
Public Sub sortFromLstBox(lstList As Access.ListBox, strSql As String, PKname As String, RankField As String)
  'First column has PK
  Dim rs As DAO.Recordset
  Dim PK As Variant
  Dim itmIndex As Integer
  Set rs = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
  For itmIndex = 0 To lstList.ListCount - 1
    PK = lstList.Column(0, itmIndex)
    rs.FindFirst PKname & " = " & PK
    rs.Edit
      rs.Fields(RankField) = itmIndex + 1
    rs.Update
  Next itmIndex
End Sub

This is the code associated with the form
Code:
Private Sub cmdUp_Click()
  mdlSortFromList.lstMoveUp Me.lstSort
  mdlSortFromList.sortFromLstBox Me.lstSort, "tblJobSteps", "jobStepID", "JobStepNumber"
  Me.Requery
End Sub
Private Sub Form_Load()
  convertToValueList Me.lstSort
End Sub
Private Sub cmdDown_Click()
  mdlSortFromList.lstMoveDown Me.lstSort
  mdlSortFromList.sortFromLstBox Me.lstSort, "tblJobSteps", "jobStepID", "JobStepNumber"
  Me.Requery
End Sub
 
puforee,
I think this can be done in a single query however you need to use the Pre TGML tag to properly align your field names and data. If you can't avoid spaces in your column names than please place []s around them.

Duane
Hook'D on Access
MS Access MVP
 
MajP...thanks, I will give it a try. dhookom...interesting...can you expound on this somewhat. I am not sure what a Pre TGML tag is.

Thanks to both of you.
 
The TGML are the code associated with the icons at the top of this box. So you can do things like

Code:
My code

Some quote

[tt]true type
true type
true type
[/tt]

Bold

makes reading tabular and code a lot easier
 
Thanks MajP. puforee once you enter your question, please use the Preview button to make sure your post looks clean and organized. Notice most of us who answer lots of questions here take the time to use TGML.

Duane
Hook'D on Access
MS Access MVP
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top