When deleting item from Listbox don't re-sort (1 Viewer)

JoseO

Registered User.
Local time
Today, 06:16
Joined
Jul 14, 2013
Messages
70
Good afternoon,

My dilemma has to do with getting a sort to “stick”.

Here’s what I have:

  • A table with 3 columns: ID/PK field – PRINTORDER – PART
  • A form that displays the record for each part
  • A Listbox control in the form with 3 columns (same as first bullet point) the ID field being hidden of course.
  • Two command buttons next to the listbox: One, moves up the selected part and the other moves the selected part down.
  • A checkbox control in the same form. When checked, it adds the name of that part to the listbox control.

The code for the move up/down buttons: (FYI, I tried indenting the code below but keep getting a
tag so I removed it)​


Code:
Private Sub MoveDownBtn_Click()

On Error GoTo errHandler

Me.SelectedPartsList.SetFocus

Call MoveUpDown(1)

Exit Sub

errHandler:

MsgBox "The following error has occurred: " & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbCritical, "Error - " & APPNAME

End Sub


Code:
Private Sub MoveUpBtn_Click()

On Error GoTo errHandler

Me.SelectedPartsList.SetFocus

Call MoveUpDown(-1)

Exit Sub

errHandler:

MsgBox "The following error has occurred: " & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbCritical, "Error - " & APPNAME

End Sub


Code:
Private Sub MoveUpDown(value As Integer)

Dim newpos As Long
Dim oldpos As Long
Dim ok As Boolean
Dim index As Long

On Error GoTo errHandler

If Me.SelectedPartsList.ListIndex = -1 Then
'Do nothing. Nothing is selected.

Else

If value = -1 Then 'move up
If Me.SelectedPartsList.ListIndex <> 0 Then
index = Me.SelectedPartsList.ListIndex - 1
oldpos = Me.SelectedPartsList.Column(1, Me.SelectedPartsList.ListIndex)
newpos = Me.SelectedPartsList.Column(1, index)
ok = True
End If

Else 'move down

If Me.SelectedPartsList.ListIndex <> Me.SelectedPartsList.ListCount - 1 Then
index = Me.SelectedPartsList.ListIndex + 1
oldpos = Me.SelectedPartsList.Column(1, Me.SelectedPartsList.ListIndex)
newpos = Me.SelectedPartsList.Column(1, index)
ok = True
End If

End If

If ok Then
DBEngine(0)(0).Execute "UPDATE PARTS_T SET PrintOrder=9999 " & _
"WHERE PrintOrder = " & newpos & ";"
DBEngine(0)(0).Execute " UPDATE PARTS_T SET PrintOrder= " & newpos & " " & _
"WHERE PrintOrder = " & oldpos & ";"
DBEngine(0)(0).Execute " UPDATE PARTS_T SET PrintOrder= " & oldpos & " " & _
"WHERE PrintOrder = 9999" & ";"
Me.SelectedPartsList.Requery
Me.SelectedPartsList = Me.SelectedPartsList.ItemData(index)
End If

End If

Exit Sub

errHandler:
MsgBox "The following error has occurred: " & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbCritical, "Error - " & APPNAME

End Sub

The code for the checkbox control:

Code:
Private Sub ADDPART_AfterUpdate()

Dim dbs As DAO.Database, Rst As DAO.Recordset
Dim SQL As String

On Error GoTo errHandler

If Me.Dirty Then Me.Dirty = False
Set dbs = CurrentDb

'ADD PARTS CHECKED

If ADDPART.value = True Then

Set Rst = dbs.OpenRecordset("PARTS_T", dbOpenDynaset)

Rst.FindFirst "[PARTID] =" & Me![PARTID]

If Not Rst.NoMatch Then
Cancel = True

MsgBox "The part: " & Chr(34) & Me.PARTTITLE & Chr(34) & " is currently part of your list.", vbExclamation, "Duplicate Part"
ADDPART.value = False

Exit Sub

End If

Set rst = dbs.OpenRecordset("PARTS_T", dbOpenDynaset)

If Not Rst.EOF Then Rst.MoveLast
SQL = "INSERT INTO PARTS_T ([PRINTORDER], [PART_TITLE], [PARTID]) VALUES (" & Rst.RecordCount + 1 & "," & Chr(34) & Me.PARTTITLE & Chr(34) & "," & Me.PARTID & ");"
RunSQLCode SQL

'ADD PARTS UNCHECKED
Else

‘Delete the selected part from the listbox.
SQL = "DELETE FROM PARTS_T WHERE [PART_TITLE]=" & Chr(34) & Me.PARTTITLE & Chr(34) & " AND [PARTID]=" & Me.PARTID
RunSQLCode SQL

Set Rst = dbs.OpenRecordset("PARTS_T", dbOpenDynaset)

If Not rst.EOF Then
Do
Rst.Edit
Rst![PRINTORDER] = Rst.AbsolutePosition + 1
Rst.Update
Rst.MoveNext
Loop Until Rst.EOF
End If
End If

'Clean up
Set rs = Nothing
Set Rst = Nothing
Set dbs = Nothing

Me.SelectedPartsList.Requery

Exit Sub

errHandler:
MsgBox "The following error has occurred: " & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbCritical, "Error - " & APPNAME

End Sub

All of the above code works well. However, here’s the problem I have been trying to fix/find a work-around and cannot:
  • As I use the up/down buttons to move my parts in the listbox control the above code also moves the parts accordingly in the PARTS_T table – all good. But;
  • If I want to remove any part from the listbox control by UNchecking the checkbox control to that part, my list gets completely rearranged.
So let’s say my list looks like this after I have added parts via the checkbox control and then used the up/down buttons (the 1 – 5 numbers are the print order):
  1. Bulb
  2. Trim piece
  3. Cup holder
  4. Arm rest
  5. Head rest
If I select “Head rest” and then uncheck the “Add Part” checkbox, rather than my list remaining in the 1 – 4 order listed above, it’ll reset to:

  1. Cup holder
  2. Arm rest
  3. Bulb
  4. Trim piece
In my DO loop, if I comment out the Rst.Update, it sorta fixes the problem but it does not update the numbers properly so I end up with something like this:

1 Bulb
2 Trim piece
3 Cup holder
5 Arm rest

I appreciate the consideration in reading this post and any feedback I absolutely welcome.

Many thanks.​
 

Mike Krailo

Active member
Local time
Today, 07:16
Joined
Mar 28, 2020
Messages
609
Without getting too deep into your particular problem, did you see the thread I started on Custom Sort Order. There were some interesting responses and examples of how your can do what your want there.

My dilemma has to do with getting a sort to “stick”.
But your title of this thread says you do not want the listbox to re-sort! Which one is it?
 

JoseO

Registered User.
Local time
Today, 06:16
Joined
Jul 14, 2013
Messages
70
Thanks Mike.

Perhaps I should have been more specific. My title should stay the same.

The problem is when I use the buttons to move the selected item up or down hence sorting my list in the listbox visibly and in the table. So, the sort is working (all the above code works just fine) when I meant that the sort is not "sticking" is explained (perhaps not as clearly) in the latter part of my post.

If I select any item in the listbox after I have used the up/down buttons and then select an item, uncheck the checkbox to remove it, the sort I have the list showing gets re-arrange. It goes from the first 5 item list (the way it should stay) to the second list which shows an item removed but the list re-sorted - not sticking.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 07:16
Joined
May 21, 2018
Messages
6,370
Code:
Set rst = dbs.OpenRecordset("PARTS_T", dbOpenDynaset)
When you open this recordset it is unsorted because you did not specify an order. So when you loop you are just setting the rank to how it was loaded.

Code:
Set rst = dbs.openrecordest ("Select * from Parts_T Order By PrintOrder", dbopendynaset)
 

JoseO

Registered User.
Local time
Today, 06:16
Joined
Jul 14, 2013
Messages
70
Giving this a whirl and reporting in a few. Thanks so much MajP!
 

JoseO

Registered User.
Local time
Today, 06:16
Joined
Jul 14, 2013
Messages
70
Good nite! MajP you are a rock star!! Thank you so much! Worked like a charm!!! :)(y)
 

Users who are viewing this thread

Top Bottom