Order items in list box

M

millie.patel

hi all --
I have a combobox (name cboProgram);
Once the program is loaded, a listbox of associated Elements are
generated.

The listbox (name lboElement), which has ElementID, ElementName,
ElementOrder

When the items appear in the list box, I have the "UP" "DOWN" arrows to
the left of it to allow the user to change the ElementOrder.

How can this be done?

Thanks!
 
D

Dirk Goldgar

hi all --
I have a combobox (name cboProgram);
Once the program is loaded, a listbox of associated Elements are
generated.

The listbox (name lboElement), which has ElementID, ElementName,
ElementOrder

When the items appear in the list box, I have the "UP" "DOWN" arrows
to the left of it to allow the user to change the ElementOrder.

How can this be done?

Where do the list items come from? If it's a table, and the table
contains the fields ElementID, ElementName, and ElementOrder, then the
process of moving an element up or down is going to involve swapping the
values of ElementOrder in two records -- probably via update queries--
and then requerying the list box.
 
D

Dirk Goldgar

The list items come from
tblElements
ElementID
ElementName
ElementOrder

I hadn't written an example of this before, so I took a moment now to do
it. Set your list box's RowSource property to this:

SELECT ElementID, ElementName, ElementOrder
FROM tblElements
ORDER BY tblElements.ElementOrder;

Name your "Up" and "Down" buttons "cmdMoveUp" and "cmdMoveDown",
respectively.

Now add the following event procedures to your form's class module:

'----- start of code -----
Private Sub cmdMoveDown_Click()

On Error GoTo Err_Handler

Dim lngCurrItem As Long
Dim lngCurrOrder As Long
Dim lngCurrRow As Long
Dim lngNextItem As Long
Dim lngNextOrder As Long
Dim lngNextRow As Long

Dim ws As DAO.Workspace
Dim db As DAO.Database

Dim fInTrans As Boolean

With Me.lboElement

If IsNull(.Value) Then
DoCmd.Beep
Exit Sub
End If

lngCurrRow = .ItemsSelected(0)
If lngCurrRow = (.ListCount - 1) Then
DoCmd.Beep
Exit Sub
End If

lngCurrItem = .Value
lngCurrOrder = .Column(2)

lngNextRow = lngCurrRow + 1
lngNextItem = .ItemData(lngNextRow)
lngNextOrder = .Column(2, lngNextRow)

Set ws = DBEngine.Workspaces(0)
Set db = ws.Databases(0)

ws.BeginTrans
fInTrans = True

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngNextOrder & _
" WHERE ElementID = " & lngCurrItem, _
dbFailOnError

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngCurrOrder & _
" WHERE ElementID = " & lngNextItem, _
dbFailOnError

ws.CommitTrans

.Requery

End With

Exit_Point:
On Error Resume Next
If fInTrans Then
ws.Rollback
End If
Set db = Nothing
Set ws = Nothing
Exit Sub

Err_Handler:
MsgBox Err.Description, vbExclamation, "Error " & Err.Number
Resume Exit_Point

End Sub

Private Sub cmdMoveUp_Click()

On Error GoTo Err_Handler

Dim lngCurrItem As Long
Dim lngCurrOrder As Long
Dim lngCurrRow As Long
Dim lngPrevItem As Long
Dim lngPrevOrder As Long
Dim lngPrevRow As Long

Dim ws As DAO.Workspace
Dim db As DAO.Database

Dim fInTrans As Boolean

With Me.lboElement

If IsNull(.Value) Then
DoCmd.Beep
Exit Sub
End If

lngCurrRow = .ItemsSelected(0)
If lngCurrRow = 0 Then
DoCmd.Beep
Exit Sub
End If

lngCurrItem = .Value
lngCurrOrder = .Column(2)

lngPrevRow = lngCurrRow - 1
lngPrevItem = .ItemData(lngPrevRow)
lngPrevOrder = .Column(2, lngPrevRow)

Set ws = DBEngine.Workspaces(0)
Set db = ws.Databases(0)

ws.BeginTrans
fInTrans = True

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngPrevOrder & _
" WHERE ElementID = " & lngCurrItem, _
dbFailOnError

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngCurrOrder & _
" WHERE ElementID = " & lngPrevItem, _
dbFailOnError

ws.CommitTrans

.Requery

End With

Exit_Point:
On Error Resume Next
If fInTrans Then
ws.Rollback
End If
Set db = Nothing
Set ws = Nothing
Exit Sub

Err_Handler:
MsgBox Err.Description, vbExclamation, "Error " & Err.Number
Resume Exit_Point

End Sub
'----- end of code -----

NOTE: the above code assumes that the list box has its ColumnHeads
property set to No. If you're displaying column heads in the list box,
a couple of minor changes have to be made to the code.
 
M

millie.patel

perfect ! thanks!

Dirk said:
I hadn't written an example of this before, so I took a moment now to do
it. Set your list box's RowSource property to this:

SELECT ElementID, ElementName, ElementOrder
FROM tblElements
ORDER BY tblElements.ElementOrder;

Name your "Up" and "Down" buttons "cmdMoveUp" and "cmdMoveDown",
respectively.

Now add the following event procedures to your form's class module:

'----- start of code -----
Private Sub cmdMoveDown_Click()

On Error GoTo Err_Handler

Dim lngCurrItem As Long
Dim lngCurrOrder As Long
Dim lngCurrRow As Long
Dim lngNextItem As Long
Dim lngNextOrder As Long
Dim lngNextRow As Long

Dim ws As DAO.Workspace
Dim db As DAO.Database

Dim fInTrans As Boolean

With Me.lboElement

If IsNull(.Value) Then
DoCmd.Beep
Exit Sub
End If

lngCurrRow = .ItemsSelected(0)
If lngCurrRow = (.ListCount - 1) Then
DoCmd.Beep
Exit Sub
End If

lngCurrItem = .Value
lngCurrOrder = .Column(2)

lngNextRow = lngCurrRow + 1
lngNextItem = .ItemData(lngNextRow)
lngNextOrder = .Column(2, lngNextRow)

Set ws = DBEngine.Workspaces(0)
Set db = ws.Databases(0)

ws.BeginTrans
fInTrans = True

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngNextOrder & _
" WHERE ElementID = " & lngCurrItem, _
dbFailOnError

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngCurrOrder & _
" WHERE ElementID = " & lngNextItem, _
dbFailOnError

ws.CommitTrans

.Requery

End With

Exit_Point:
On Error Resume Next
If fInTrans Then
ws.Rollback
End If
Set db = Nothing
Set ws = Nothing
Exit Sub

Err_Handler:
MsgBox Err.Description, vbExclamation, "Error " & Err.Number
Resume Exit_Point

End Sub

Private Sub cmdMoveUp_Click()

On Error GoTo Err_Handler

Dim lngCurrItem As Long
Dim lngCurrOrder As Long
Dim lngCurrRow As Long
Dim lngPrevItem As Long
Dim lngPrevOrder As Long
Dim lngPrevRow As Long

Dim ws As DAO.Workspace
Dim db As DAO.Database

Dim fInTrans As Boolean

With Me.lboElement

If IsNull(.Value) Then
DoCmd.Beep
Exit Sub
End If

lngCurrRow = .ItemsSelected(0)
If lngCurrRow = 0 Then
DoCmd.Beep
Exit Sub
End If

lngCurrItem = .Value
lngCurrOrder = .Column(2)

lngPrevRow = lngCurrRow - 1
lngPrevItem = .ItemData(lngPrevRow)
lngPrevOrder = .Column(2, lngPrevRow)

Set ws = DBEngine.Workspaces(0)
Set db = ws.Databases(0)

ws.BeginTrans
fInTrans = True

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngPrevOrder & _
" WHERE ElementID = " & lngCurrItem, _
dbFailOnError

db.Execute _
"UPDATE tblElements SET ElementOrder = " & lngCurrOrder & _
" WHERE ElementID = " & lngPrevItem, _
dbFailOnError

ws.CommitTrans

.Requery

End With

Exit_Point:
On Error Resume Next
If fInTrans Then
ws.Rollback
End If
Set db = Nothing
Set ws = Nothing
Exit Sub

Err_Handler:
MsgBox Err.Description, vbExclamation, "Error " & Err.Number
Resume Exit_Point

End Sub
'----- end of code -----

NOTE: the above code assumes that the list box has its ColumnHeads
property set to No. If you're displaying column heads in the list box,
a couple of minor changes have to be made to the code.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top