Solved Move row up and down in Listbox (1 Viewer)

[Gizem]

Hello together,

I am the first time here. I have a huge problem, maybe you can help me. I have a listbox and two buttons. I would like to move a selected element in the listbox up with the UP-BUTTON. With the DOWN-BUTTON, i would like to move the selected element down.
The data which you can see in the listbox is from a table.

Thank you in advance
Gizem

 

[Ranman256]

listbox normally doesnt do that, but youd have to have a SORTORDER field,
when user clicks UP ,use vb to renumber all the items there and below.

 

[Gizem]

listbox normally doesnt do that, but youd have to have a SORTORDER field,
when user clicks UP ,use vb to renumber all the items there and below.

can you explain me what a SORTORDER field is?

 

[Gasman]

Hello together,

I am the first time here. I have a huge problem, maybe you can help me. I have a listbox and two buttons. I would like to move a selected element in the listbox up with the UP-BUTTON. With the DOWN-BUTTON, i would like to move the selected element down.
The data which you can see in the listbox is from a table.

Thank you in advance
Gizem

I always start here?

 

[Gasman]

On the premise that a picture is worth a thousand words

 

[MajP]

This turns any listbox into a sortable listbox with little code. Need to import the class and follow the example.

MS Access: custom control built in another language

the code is old and there is a small change you need to make in several functions, e.g. fIsScrollBar, there is a line which is used to identify the scrollbar for a window If fGetClassName(hWnd_VSB) = "scrollBar" Then this needs to be changed to If fGetClassName(hWnd_VSB) = "NUIscrollBar"...

www.access-programmers.co.uk

 

[The_Doc_Man]

can you explain me what a SORTORDER field is?

Actually, that's easy. SQL syntax has a syntax element called "ORDER BY" which lets you specify the order in which something appears through the query. The syntax element that follows an ORDER BY is a list of one or more fields defining the order of sorting. These listed fields are all sort order fields.

 

[arnelgp]

here is also a demo but the listbox rowsource is Table/query.

 

[arnelgp]

updated 1 form for Table/Query Rowsource Type and the other form is
for Value/List Rowsource Type.

the Value/List can be multiple column.

 

[theDBguy]

Hi @Gizem. Welcome to AWF!

Please try the demoes posted and let us know how it goes. Good luck!

 

[Gizem]

here is also a demo but the listbox rowsource is Table/query.

I tried this one because it is quite similar to my problem. I add a third colomn to my table like the demo and named it also POSITION. I got a run-time-error 13 'Type mismatch'. Also i have changed the declaration to variant. But now i got an other run-time error maybe you can find the failure.

Private Sub MoveUpDown(value As Integer)
Dim newpos As Variant
Dim oldpos As Variant
Dim ok As Boolean
Dim index As Long
If Me.Liste13.ListIndex = -1 Then
'do nothing nothing is selected

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

ok = True
End If
End If
If ok Then
DBEngine(0)(0).Execute "update ProjekteName set position=9999 " & _
"where position = " & newpos & ";"
DBEngine(0)(0).Execute "UPDATE ProjekteName set position= " & newpos & " " & _
"where position = " & oldpos & ";"
DBEngine(0)(0).Execute "UPDATE ProjekteName set position= " & oldpos & " " & _
"where position = 9999" & ";"
Me.Liste13.Requery
Me.Liste13 = Me.Liste13.ItemData(index)
End If
End If
End Sub

DBEngine(0)(0).Execute "update ProjekteName set position=9999 " & _
"where position = " & newpos & ";"

Run-time-error '3075'
Syntax error(missing operator) in query expression 'position=...'

I can't find the failure it is so annoying

 

[theDBguy]

Run-time-error '3075'
Syntax error(missing operator) in query expression 'position=...'

That error indicates newpos is empty. Try amending the code with this.

newpos = Nz(Me.Liste13.Column(0, index),0)

Hope that helps...

 

[Gizem]

That error indicates newpos is empty. Try amending the code with this.

newpos = Nz(Me.Liste13.Column(0, index),0)

Hope that helps...

It doesn't work Thank you for your support

 

[theDBguy]

It doesn't work Thank you for your support

Same error? Different error?

 

[Gizem]

Same error? Different error?

Same error But are you sure about newpos is empty

 

[Gasman]

Same error But are you sure about newpos is empty

Well walk through the code with F8 and see?
If you do not know how to do that, see the Debugging Access VBA link in my signature

 

[Gizem]

Well walk through the code with F8 and see?
If you do not know how to do that, see the Debugging Access VBA link in my signature

Okay i will do it now.

 

[theDBguy]

Same error But are you sure about newpos is empty

Well, I can't be 100% sure, since I can't see what you're looking at, but I was just going by this earlier statement from your post.

Run-time-error '3075'
Syntax error(missing operator) in query expression 'position=...'

That tells me a value is missing after the equals sign. Normally, if it's not empty, you would have seen something like:

'position=x'

Hope that makes sense...

 

[isladogs]

In case it helps, here is some code from one of my commercial apps to do exactly the same thing:
The form has a listbox lstItinerary whose row source is tblRoutePlanner and the order is set using integer field RouteOrderNo - this is Column(1)

The form has 2 procedures: MoveUp & MoveDown:

Option Compare Database
Option Explicit

Dim itm As Variant
Dim intStart As Integer, intEnd As Integer

Private Sub MoveUp(intStart As Integer, intEnd As Integer)

On Error GoTo Err_Handler

    If intStart <= 0 Or intEnd <= 0 Then Exit Sub
   
    CurrentDb.Execute "UPDATE tblRoutePlanner SET RouteOrderNo = (RouteOrderNo - 1)" & _
        " WHERE RouteOrderNo BETWEEN " & Me.LstItinerary.Column(1, intStart) & " AND " & Me.LstItinerary.Column(1, intEnd) & ";"
   
    CurrentDb.Execute "UPDATE tblRoutePlanner SET RouteOrderNo = " & Me.LstItinerary.Column(1, intEnd) + 1 & _
        " WHERE ID=" & Me.LstItinerary.Column(0, intStart - 1) & ";"
       
    Me.LstItinerary.Selected(intStart - 1) = True
    Me.LstItinerary.Selected(intEnd) = False
   
    intStart = -1
    intEnd = -1
   
Exit_Handler:
    Exit Sub
   
Err_Handler:
   MsgBox "Error " & Err.Number & " in MoveUp procedure :" & vbCrLf & _
        Err.description, vbCritical, "Program error"
    Resume Exit_Handler
   
End Sub

Private Sub MoveDown(intStart As Integer, intEnd As Integer)

On Error GoTo Err_Handler

    If intStart < 0 Or intEnd < 0 Then Exit Sub
    If intEnd + 1 > Me.LstItinerary.ListCount - 1 Then Exit Sub
   
   ' Debug.Print intStart, intEnd
   
    CurrentDb.Execute "UPDATE tblRoutePlanner SET RouteOrderNo = (RouteOrderNo + 1)" & _
        " WHERE RouteOrderNo BETWEEN " & Me.LstItinerary.Column(1, intStart) & " AND " & Me.LstItinerary.Column(1, intEnd) & ";"
   
    CurrentDb.Execute "UPDATE tblRoutePlanner SET RouteOrderNo = " & Me.LstItinerary.Column(1, intStart) - 1 & _
        " WHERE ID=" & Me.LstItinerary.Column(0, intEnd + 1) & ";"
       
    Me.LstItinerary.Selected(intStart) = False
    Me.LstItinerary.Selected(intEnd + 1) = True
   
    intStart = -1
    intEnd = -1
   
Exit_Handler:
    Exit Sub
   
Err_Handler:
   MsgBox "Error " & Err.Number & " in MoveDown procedure :" & vbCrLf & _
        Err.description, vbCritical, "Program error"
    Resume Exit_Handler
   
End Sub

These are called using two buttons cmdUp & cmdDown which move individual listbox items up & down (as you would expect...!)

Private Sub cmdDown_Click()

On Error GoTo Err_Handler

   If Me.LstItinerary.ItemsSelected.count = 0 Then Exit Sub
 
    intStart = -1: intEnd = -1
   
    For Each itm In Me.LstItinerary.ItemsSelected
        If intStart < 0 Then intStart = itm
        If intEnd < 0 Then intEnd = itm
       
        If itm > intEnd + 1 Then
            MoveDown intStart, intEnd
            intStart = itm
        End If
        intEnd = itm

    Next
   
    MoveDown intStart, intEnd
    Me.LstItinerary.Requery
   
    itm = Null
   
Exit_Handler:
    Exit Sub
   
Err_Handler:
   MsgBox "Error " & Err.Number & " in cmdDown_Click procedure :" & vbCrLf & _
        Err.description, vbCritical, "Program error"
    Resume Exit_Handler
   
End Sub


Private Sub cmdUp_Click()

On Error GoTo Err_Handler

    If Me.LstItinerary.ItemsSelected.count = 0 Then Exit Sub
 
    Dim intStart As Integer, intEnd As Integer
    intStart = -1: intEnd = -1
    For Each itm In Me.LstItinerary.ItemsSelected
       
        If intStart < 0 Then intStart = itm
        If intEnd < 0 Then intEnd = itm
       
        If itm > intEnd + 1 Then
            MoveUp intStart, intEnd
            intStart = itm
        End If
        intEnd = itm
       
        'Debug.Print intStart, intEnd

    Next
    MoveUp intStart, intEnd
    Me.LstItinerary.Requery
   
    itm = Null
   
Exit_Handler:
    Exit Sub
   
Err_Handler:
   MsgBox "Error " & Err.Number & " in cmdUp_Click procedure :" & vbCrLf & _
        Err.description, vbCritical, "Program error"
    Resume Exit_Handler

End Sub

Hope that helps

 

[MajP]

If you use my class module this is the entire code that is required to make this work on any listbox.

Public WithEvents lstUpDwn As ListMoveUpDown 'Using the event
Private Sub Form_Load()
  Set lstUpDwn = New ListMoveUpDown
  lstUpDwn.InitializeList Me.lstSort, Me.cmdup, Me.cmdDown, Me.cmdTop, Me.cmdBottom, Me.cmdDeselect
  'Initialize the second
End Sub

The class controls all the buttons, enables drag and drop (with limits), and exposes events and other properties to track the reordering.