Sequencial Entries ? 1

[DougHomeOffice]

Does anyone have a ready to go solution for changinging the sequence in a list box. For Examle:

Task Order Task
--------------------
1 Enter invoices
2 Create Project
3 Close store

Basically i'm looking for buttons and code to move these list box entries up and down.

*of course there is a hidden id column etc.

-Doug

 

[BoxHead]

Doug,

I didn't have anything 'ready-made' but it sure seemed like a question I'd be asking soon enough.

The following will update the Task Order in the table and requery the listbox. It assumes the table has at least 3 columns: TaskID, TaskOrder, & Task.

The Form, frmTasksToDo, has a listbox called lstTasks (ordered by TaskOrder Ascending) and 2 command buttons: Command2 & Command3. TaskOrder is the second column or Column(1) in the list box.

Command2 moves the selected list item up one row and moves the item that occupied that row down to replace it. Command3 moves the selected item down and replaces it with whatever was next on the list.

There's a function at the beginning ("ButtonCheck&quot that disables Command2 if the selected item is already first in the listbox and disables Command3 if it is already at the end of the list. The function is called on the listbox's BeforeUpdate and both of the button's click events.

HTH

Option Compare Database
Option Explicit
_____________________________
Private Function ButtonCheck()

If lstTasks.Column(1) = 1 Then
  Command2.Enabled = False
Else
  Command2.Enabled = True
End If

If lstTasks.Column(1) = lstTasks.ListCount Then
  Command3.Enabled = False
Else
  Command3.Enabled = true
End If
________________________________

Private Sub Command2_Click()

Dim MyPos As Integer
MyPos = LstTasks.Column(1)
Dim PrevPos As Integer
PrevPos = DLookup("[taskID]", "tblTasks", "[taskorder] = " & Me.LstTasks.Column(1) - 1)

DoCmd.SetWarnings False

DoCmd.RunSQL "UPDATE tblTasks " & _
  "SET tblTasks.TaskOrder = tblTasks.TaskOrder - 1 " & _
  "WHERE tblTasks.TaskOrder = " & MyPos & "; "

DoCmd.RunSQL "UPDATE tblTasks " & _
  "SET tblTasks.TaskOrder = tblTasks.TaskOrder + 1 " & _
  "WHERE tblTasks.TaskID = " & PrevPos & "; "

LstTasks.Requery
DoCmd.SetWarnings True
LstTasks.SetFocus
ButtonCheck

End Sub
___________________________________

Private Sub Command3_Click()

Dim MyPos As Integer
MyPos = LstTasks.Column(1)
Dim NextPos As Integer
NextPos = DLookup("[taskID]", "tblTasks", "[taskorder] = " & Me.LstTasks.Column(1) + 1)

DoCmd.SetWarnings False

DoCmd.RunSQL "UPDATE tblTasks " & _
  "SET tblTasks.TaskOrder = tblTasks.TaskOrder + 1 " & _
  "WHERE tblTasks.TaskOrder = " & MyPos & "; "

DoCmd.RunSQL "UPDATE tblTasks " & _
  "SET tblTasks.TaskOrder = tblTasks.TaskOrder - 1 " & _
  "WHERE tblTasks.TaskID = " & NextPos & "; "

LstTasks.Requery
DoCmd.SetWarnings True
LstTasks.SetFocus
ButtonCheck

End Sub
___________________________________

Private Sub LstTasks_BeforeUpdate(Cancel As Integer)
ButtonCheck
End Sub

Two afterthoughts:
1.) I tried this out on a computer without internet access so watch for typos in the above.
2.) The ButtonCheck function requires that the focus be shifted from the command button before running (can't disable a button when it has the focus). This may be an issue if users are going to be moving an item quite a few rows. It requires an actual click instead of holding down the Enter key. You could skip disabling the buttons and use the If...Then statements around the command button click events. Whatever works for you.

John

Use what you have,
Learn what you can,
Create what you need.

 

[DougHomeOffice]

Thanks, you gave me the frame work i needed to get started and much more...

-Doug

 

[DougHomeOffice]

This is what i got...

-------------------------------------------
Dim vCurrentSelectionOrder As Integer
Dim vCurrentSelectionTaskID As Long
Dim vAboveSelectionTaskID As Long
Dim y

vCurrentSelectionOrder = Me.Task_List.Column(2)

If IsNull(vCurrentSelectionOrder) Then
y = MsgBox("Please select a task", vbOKOnly, "SELECT TASK&quot
Exit Sub
End If
If vCurrentSelectionOrder = 1 Then
Exit Sub
End If

vCurrentSelectionTaskID = Me.Task_List.Column(0)
vAboveSelectionTaskID = Me.Task_List.Column(0, Me.Task_List.ListIndex - 1)

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE Tasks " & _
"SET Tasks.[Task Order] = Tasks.[Task Order] - 1 " & _
"WHERE Tasks.[Task ID] = " & vCurrentSelectionTaskID & "; "

DoCmd.RunSQL "UPDATE Tasks " & _
"SET Tasks.[Task Order] = Tasks.[Task Order] + 1 " & _
"WHERE Tasks.[Task ID] = " & vAboveSelectionTaskID & "; "

Me.Task_List.Requery
DoCmd.SetWarnings True
---------------------------------------

-Doug

 

[DougHomeOffice]

Also for Down

----------------

Private Sub bMoveTaskDown_Click()
Dim vCurrentSelectionOrder As Integer
Dim vCurrentSelectionTaskID As Long
Dim vBelowSelectionTaskID As Long
Dim y

vCurrentSelectionOrder = Me.Task_List.Column(2)

If IsNull(vCurrentSelectionOrder) Then
y = MsgBox("Please select a task", vbOKOnly, "SELECT TASK&quot
Exit Sub
End If
If vCurrentSelectionOrder = Me.Task_List.ListCount Then
Exit Sub
End If

vCurrentSelectionTaskID = Me.Task_List.Column(0)
vBelowSelectionTaskID = Me.Task_List.Column(0, Me.Task_List.ListIndex + 1)

DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE Tasks " & _
"SET Tasks.[Task Order] = Tasks.[Task Order] + 1 " & _
"WHERE Tasks.[Task ID] = " & vCurrentSelectionTaskID & "; "

DoCmd.RunSQL "UPDATE Tasks " & _
"SET Tasks.[Task Order] = Tasks.[Task Order] - 1 " & _
"WHERE Tasks.[Task ID] = " & vBelowSelectionTaskID & "; "

Me.Task_List.Requery
DoCmd.SetWarnings True
End Sub

 

[BoxHead]

Cool!

The message box is a nice touch and the 'exit sub' if it's already first or last is a simpler way of handling the error that would occur without disabling the buttons.

Take care,
John

Use what you have,
Learn what you can,
Create what you need.

 

[DougHomeOffice]

John,

This is for a delete button and it runumbers it...

Private Sub bDelete_Click()
Dim vCurrentSelectionOrder As Integer
Dim vCurrentSelectionTaskID As Long

If Me.Task_List.ListIndex = -1 Then Exit Sub

vCurrentSelectionTaskID = Me.Task_List.Column(0)
vCurrentSelectionOrder = Me.Task_List.Column(2)

DoCmd.SetWarnings False

For x = Me.Task_List.ListIndex + 1 To Me.Task_List.ListCount - 1
DoCmd.RunSQL "UPDATE Tasks " & _
"SET Tasks.[Task Order] = " & vCurrentSelectionOrder & _
" WHERE Tasks.[Task ID] = " & Me.Task_List.Column(0, x) & ";"
vCurrentSelectionOrder = vCurrentSelectionOrder + 1
Next x

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE Tasks.*, Tasks.[Task ID] FROM Tasks WHERE Tasks.[Task ID]=" & vCurrentSelectionTaskID & ";"
DoCmd.SetWarnings True

Me.Task_List.Requery
DoCmd.SetWarnings True
End Sub
-------------------------------
-Doug

 

[BoxHead]

Very nice, Doug.

I don't know if it would be appropriate for your application, but give some thought (if you haven't already) to appending completed tasks to a Completed Tasks Table along with completion date, completed by, resolution comment, etc...

Is there any relationship that could allow you to retrieve these by Customer, Task Type, etc?



John

Use what you have,
Learn what you can,
Create what you need.