Moving Rows in Continuous Form Up/Down and Top/Bottom

[RichardAnderson]

Hello Guys,



I am hoping this is a simple issue.

I have a form called frm_Production_Schedule_Punching. This is a continuous form with the source of qryProduction_Schedule_Punching which in turn has a source of tblFabrication.
I added a field on the table and query called PunchingSort. I added this field onto the form along with 2 buttons. The purpose of the buttons is for the user to sort the form on the fly in the order he wants his crew to do things. The form is sorted by the PunchingSort field (lowest number on top).

On these 2 buttons I put the following code.

Private Sub Command499_Click()
Me.PunchingSort = Me.PunchingSort - 1
Me.Requery
End Sub

Private Sub Command500_Click()
Me.PunchingSort = Me.PunchingSort + 1
Me.Requery
End Sub

This works great except for one thing I cannot figure out. If I click the up button for a row, it ends up with 2 rows with the same value in PunchingSort.

Does anyone know a way to fix this?

If I click the up button twice for the row with a PunchingSort value of 5 the following should happen...
1)The value gets changed to 3 (which I have working)
2)The record that already had the value of 3 needs to change to 4 and the record that is already 4 needs to change to 5
3)Then a requery is performed.

Also, move to top or bottom buttons would be great to automatically updating the PunchingSort field

The length of this continuous form can vary.

[RichardAnderson]

I found some code posted somewhere and made it work for me.

Private Sub Command499_Click()

If Me!PunchingSort <= 1 Then
MsgBox "This record cannot move up"
Exit Sub
End If
Dim NewPos As Integer
NewPos = Me!PunchingSort - 1
Me!PunchingSort = NewPos
DoCmd.GoToRecord , , acPrevious
Me!PunchingSort = Me!PunchingSort + 1
Me.Requery
Me.PunchingSort.SetFocus
DoCmd.FindRecord NewPos


End Sub


Private Sub Command500_Click()


Dim NewPos As Integer
NewPos = Me!PunchingSort + 1
Me!PunchingSort = NewPos
DoCmd.GoToRecord , , acNext
Me!PunchingSort = Me!PunchingSort - 1
Me.Requery
Me.PunchingSort.SetFocus
DoCmd.FindRecord NewPos


End Sub

The Only problem is. I also want to have the option to move a row to the top and then renumber everything below. If anyone know the change I need to make, it would be awesome.

[RichardAnderson]

OK .... I think I have a solution for a "move to top" command.

But the code errors on the line

intNeedPunching = DCount("[FabID]", "[tblFabrication]", "[NeedPunching] =True AND [Completed] =False AND [PunchingSort] <CurrentPos")

FabID is the unique field in the table tblFabrication. The table has all 3 of the fields NeedPunching, Completed, and PunchingSort.
CurrentPos is the variable that holds the value of PunchingSort before it gets changed.

The Full Code

Private Sub Command542_Click()


If Me!PunchingSort <= 1 Then
MsgBox "This record cannot move up"
Exit Sub
End If
Dim CurrentPos As Integer
Dim NewPos As Integer
Dim intNeedPunching As Integer
CurrentPos = Me!PunchingSort
NewPos = 1
intNeedPunching = DCount("[FabID]", "[tblFabrication]", "[NeedPunching] =True AND [Completed] =False AND [PunchingSort] <CurrentPos")
Me!PunchingSort = NewPos
For Index = 1 To intNeedPunching
    DoCmd.GoToRecord , , acPrevious
    Me!PunchingSort = Me!PunchingSort + 1
Next
Me.Requery
Me.PunchingSort.SetFocus
DoCmd.FindRecord NewPos


End Sub