VB is not working correctly

[sjmojeck]

Hi,
I am using the vb script at the end of this message to assign sessions to students. It works for the most part, however, every few records the order of assigned sessions is reversed for no apparent reason. Any help would be appreciated. Thanks

' Recordsets
Dim Studs As Recordset ' student detail
Dim Choices As Recordset ' the students choices
Dim qdfChoices As QueryDef ' querydef to create choices recordset

' Numbers
Dim TotalStuds As Integer ' total number of students to be processed
Dim i As Integer ' counter for passes
Dim j As Integer ' counter for students

' Variants
Dim varStuds As Variant ' status bar for students

' Strings
Dim strCrit As String ' criteria for opening recordsets
Dim strTopic As String ' temp topic
Dim strSession As String ' temp session

' Boolean
Dim booAss1 As Boolean ' Assigned session 1 open
Dim booAss2 As Boolean ' Assigned session 2 open
Dim booAss3 As Boolean ' Assigned session 3 open


' Open students
Set Studs = CurrentDb.OpenRecordset("CIF_Students", dbOpenDynaset)
Studs.MoveLast
Studs.MoveFirst
TotalStuds = Studs.RecordCount
Set qdfChoices = CurrentDb.CreateQueryDef("&quot

varStuds = SysCmd(acSysCmdInitMeter, "Assigning Sessions...", TotalStuds * 3)

For i = 1 To 3
varStuds = SysCmd(acSysCmdUpdateMeter, 0)
For j = 1 To TotalStuds
strCrit = "SELECT * FROM [CIF_Choices] WHERE [STUD_ID] = " & Studs![STUD_ID]
qdfChoices.SQL = strCrit
Set Choices = qdfChoices.OpenRecordset()
booAss1 = True
booAss2 = True
booAss3 = True
While Not Choices.EOF
Select Case Choices![ASSIGN_SESSION]
Case "1"
booAss1 = False
Case "2"
booAss2 = False
Case "3"
booAss3 = False
End Select
Choices.MoveNext
Wend
If Not Choices.BOF Then Choices.MoveFirst
Do While Not Choices.EOF
If IsNull(Choices![ASSIGN_SESSION]) Then
strTopic = Choices![TOPIC]
If booAss1 And IsOpen(strTopic, "1&quot Then
strSession = "1"
ElseIf booAss2 And IsOpen(strTopic, "2&quot Then
strSession = "2"
ElseIf booAss3 And IsOpen(strTopic, "3&quot Then
strSession = "3"
Else
strSession = "0"
End If
Choices.Edit
Choices![ASSIGN_SESSION] = strSession
Choices.Update
If strSession = 0 Then
Choices.MoveNext
Else
Exit Do
End If
Else
Choices.MoveNext
End If
Loop
Studs.MoveNext
Choices.Close
varStuds = SysCmd(acSysCmdUpdateMeter, i * j)
Next j
Studs.MoveFirst
Next i

' Close Status bars
varStuds = SysCmd(acSysCmdClearStatus)

' Close recordsets
Studs.Close

' Free memory
Set Studs = Nothing
Set Choices = Nothing
End Sub

Function FindMax(strTopic As String) As Integer
Dim Presenters As Recordset
Dim Rooms As Recordset
Dim intMax As Integer

Set Presenters = CurrentDb.OpenRecordset("CIF_Presenters", dbOpenDynaset)
Set Rooms = CurrentDb.OpenRecordset("CIF_Bldg_Room_Cap", dbOpenDynaset)

intMax = 0
Presenters.FindFirst "[TOPIC] = '" & strTopic & "'"
If Not Presenters.NoMatch Then
Rooms.FindFirst "[ROOM_NO] = '" & Presenters![ROOM_NO] & "'"
If Not Rooms.NoMatch Then
intMax = Rooms![CAPACITY]
End If
End If
Presenters.Close
Set Presenters = Nothing
Rooms.Close
Set Rooms = Nothing
FindMax = intMax
End Function

Function FindCurrent(strTopic As String, strSession As String) As Integer
On Error GoTo ER_Handler
Dim Current As Recordset
Dim strCrit As String

strCrit = "SELECT * FROM [CIF_Choices] WHERE [TOPIC] = '" & strTopic & _
"' AND [ASSIGN_SESSION] = '" & strSession & "'"

Set Current = CurrentDb.OpenRecordset(strCrit, dbOpenDynaset)
Current.MoveLast
FindCurrent = Current.RecordCount
Current.Close
Set Current = Nothing
Exit Function

ER_Handler:
Set Current = Nothing
FindCurrent = 0
End Function

Function IsOpen(strTopic As String, strSession As String) As Boolean
Dim Topics As Recordset
Dim strCrit As String
Dim booOpen As Boolean
Dim intMax As Integer
Dim intCurrent As Integer

Set Topics = CurrentDb.OpenRecordset("CIF_Presenters", dbOpenDynaset)
strCrit = "[TOPIC] = '" & strTopic & "'"
Topics.FindFirst strCrit
If Not Topics.NoMatch Then
Select Case strSession
Case "1"
booOpen = Topics![Session1Open]
Case "2"
booOpen = Topics![Session2Open]
Case "3"
booOpen = Topics![Session3Open]
Case Else
booOpen = False
End Select
Else
booOpen = False
End If
If booOpen Then
intMax = FindMax(strTopic)
intCurrent = FindCurrent(strTopic, strSession)
If intCurrent >= intMax Then booOpen = False
End If
Topics.Close
Set Topics = Nothing
IsOpen = booOpen
End Function