Update Rank List - Why does this code not work?!

[Steve]

I have created a database with a single data table [tblProjects] with a
[ProjectsID] Autonumber Key field, a [ProjectTitle] text field, and a
[RankOrder] Number (integer) field. There is a form called frmRankOrder
(recordsouce tblProject) with 2 unbound contols - ListBxRankOrder with a
rowsource = SELECT tblProject.ProjectID, tblProject.RankOrder,
tblProject.ProjectTitle FROM tblProject ORDER BY [RankOrder]; and
cboNewRankOrder with a row source = SELECT tlkpRankOrder.RankOrderLookup FROM
tlkpRankOrder ORDER BY [RankOrderLookup]; in which RankOrderLookup is a list
of numbers form 1 to 10.
Oddly, the code sometimes works (or at least comes close). Other times it
gives me the following error:

RunTime Error 2115 the macro or function set to the before update or
validation rule property for this field is preventing microsoft access from
saving the data in the field.

Here is the code:

Option Compare Database

Private Sub cboNewRankOrder_AfterUpdate()

Dim ListBxCount As Integer
Dim ListBxCounter As Integer
Dim X As Integer
Dim intNewRankOrder As Integer
Dim intOldRankOrder As Integer
Dim intProjID As Integer

intNewRankOrder = Me.cboNewRankOrder


'set X = 0
X = 0

'Check to see if an item was selected
ListBxCount = ListBxRankOrder.ListCount - 1
For ListBxCounter = 0 To ListBxCount
If ListBxRankOrder.Selected(ListBxCounter) = True Then
X = X + 1
End If
Next ListBxCounter
If X = 0 Then
MsgBox "You must select a project!"
Exit Sub
End If

'determine the oldRankOrder and ProjectID for the selected project
ListBxCount = ListBxRankOrder.ListCount - 1
For ListBxCounter = 0 To ListBxCount
If ListBxRankOrder.Selected(ListBxCounter) = True Then
intOldRankOrder = Me.ListBxRankOrder.Column(1, ListBxCounter)
intProjID = Me.ListBxRankOrder.Column(0, ListBxCounter)
ListBxRankOrder.Selected(ListBxCounter) = False
End If
Next ListBxCounter

DoCmd.SetWarnings False 'suppresses action query warnings
'add 1 to all the rank order fields in table project where the rankorder is
greater than or equal to the new rank order but less than the old rank order

DoCmd.RunSQL ("UPDATE tblProject SET tblProject.RankOrder =" & [RankOrder] &
"+1" & _
" WHERE tblProject.RankOrder >=" & intNewRankOrder & "AND
tblProject.RankOrder <" & intOldRankOrder)

'set the selected projects rank order to the value chosen by the user from
the unbound combo box

DoCmd.RunSQL ("UPDATE tblProject SET tblProject.RankOrder =" &
intNewRankOrder & _
" WHERE tblProject.ProjectID =" & intProjID)

DoCmd.SetWarnings True

Me.Recalc

End Sub

 

[John Smith]

I wonder if your failed attempts tried to create a duplicate rank and violated
the table key, unique index or validation rule?

Try debug.print for the SQL and checking the details against the data, this
should show the problem.

John
##################################
Don't Print - Save trees

I have created a database with a single data table [tblProjects] with a
[ProjectsID] Autonumber Key field, a [ProjectTitle] text field, and a
[RankOrder] Number (integer) field. There is a form called frmRankOrder
(recordsouce tblProject) with 2 unbound contols - ListBxRankOrder with a
rowsource = SELECT tblProject.ProjectID, tblProject.RankOrder,
tblProject.ProjectTitle FROM tblProject ORDER BY [RankOrder]; and
cboNewRankOrder with a row source = SELECT tlkpRankOrder.RankOrderLookup FROM
tlkpRankOrder ORDER BY [RankOrderLookup]; in which RankOrderLookup is a list
of numbers form 1 to 10.
Oddly, the code sometimes works (or at least comes close). Other times it
gives me the following error:

RunTime Error 2115 the macro or function set to the before update or
validation rule property for this field is preventing microsoft access from
saving the data in the field.

Here is the code:

Option Compare Database

Private Sub cboNewRankOrder_AfterUpdate()

Dim ListBxCount As Integer
Dim ListBxCounter As Integer
Dim X As Integer
Dim intNewRankOrder As Integer
Dim intOldRankOrder As Integer
Dim intProjID As Integer

intNewRankOrder = Me.cboNewRankOrder


'set X = 0
X = 0

'Check to see if an item was selected
ListBxCount = ListBxRankOrder.ListCount - 1
For ListBxCounter = 0 To ListBxCount
If ListBxRankOrder.Selected(ListBxCounter) = True Then
X = X + 1
End If
Next ListBxCounter
If X = 0 Then
MsgBox "You must select a project!"
Exit Sub
End If

'determine the oldRankOrder and ProjectID for the selected project
ListBxCount = ListBxRankOrder.ListCount - 1
For ListBxCounter = 0 To ListBxCount
If ListBxRankOrder.Selected(ListBxCounter) = True Then
intOldRankOrder = Me.ListBxRankOrder.Column(1, ListBxCounter)
intProjID = Me.ListBxRankOrder.Column(0, ListBxCounter)
ListBxRankOrder.Selected(ListBxCounter) = False
End If
Next ListBxCounter

DoCmd.SetWarnings False 'suppresses action query warnings
'add 1 to all the rank order fields in table project where the rankorder is
greater than or equal to the new rank order but less than the old rank order

DoCmd.RunSQL ("UPDATE tblProject SET tblProject.RankOrder =" & [RankOrder] &
"+1" & _
" WHERE tblProject.RankOrder >=" & intNewRankOrder & "AND
tblProject.RankOrder <" & intOldRankOrder)

'set the selected projects rank order to the value chosen by the user from
the unbound combo box

DoCmd.RunSQL ("UPDATE tblProject SET tblProject.RankOrder =" &
intNewRankOrder & _
" WHERE tblProject.ProjectID =" & intProjID)

DoCmd.SetWarnings True

Me.Recalc

End Sub