Need review of code to select random record from table

[mikenelena]

I am trying to code a game to help my kids with their foreign language studies. I need to pull a verb at random from a table of about 375 records. A search online produced the following code that sort of works. After about 30 or 40 verbs though, the program throws a Run Time Error 3021: No Current Record. I suspect this has something to do with the "pattern" of randomness eventually hitting the end of the recordset, but I don't know how to resolve the issue. Ideally no verb should be repeated in a single session of the game, and the supply of verbs should not run out until all have been used.

(You'll also notice that I have a lot of duplicate lines of code between the called function and the subroutine. I wasn't really clear on which lines of code needed to be in the sub as opposed to in the function. If anyone can clarify that for me, I'd appreciate that too.)

Thanks in advance to anyone who can help straighten me out!!

Dim db          As DAO.Database
Dim rs          As DAO.Recordset
Dim tblName     As String   'Table to pull random record from
Dim iRecCount   As Long     'Number of record in the table
Dim iRndRecNum  As Integer
Dim CurrentVerb As String
Dim Stem As String
Dim Stem1 As String
Dim Stem2 As String

Select Case Me.cmdVerbType.Value

    Case Is = "Regular ER"

        tblName = "Regular ER"
    
    Case Is = "Regular IR"
    
        tblName = "Regular IR"
        
    Case Is = "Regular RE"
    
        tblName = "Regular RE"
    
End Select

    Set db = CurrentDb()
    Set rs = db.OpenRecordset(tblName, dbOpenSnapshot, dbReadOnly, dbReadOnly)
 
    If rs.RecordCount <> 0 Then 'ensure there are records in the table before proceeding
        With rs
            rs.MoveLast   'move to the end to ensure accurate recordcount value
            iRecCount = rs.RecordCount
            iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1) 'Get Random Rec Number to use
            'iRndRecNum = Int((iRecCount - 1 + 1) * Rnd(-(100000 * ID) * Time())) <-----------------------------------------[COLOR=rgb(226, 80, 65)][B]This was an alternate line that I tried.[/B][/COLOR]
            rs.MoveFirst
            .Move CLng(iRndRecNum)
            Me.CurrentVerb = GetRndRec = ![Verb] [COLOR=rgb(226, 80, 65)][B]<---------------------------------------------------------This is line throwing the error.[/B][/COLOR]
        End With
    End If

Me.CurrentVerb = GetRndRec

This is the code of the function that is called:
-------------------------------------------------------------------------------

Function GetRndRec()
'On Error GoTo Error_Handler
    Dim db          As DAO.Database
    Dim rs          As DAO.Recordset
    Dim tblName     As String   'Table to pull random record from
    Dim iRecCount   As Long     'Number of record in the table
    Dim iRndRecNum  As Integer
 
    'tblName = "ER_Verbs"
    tblName = Forms![French Game].cmdVerbType
    
    
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(tblName, dbOpenSnapshot, dbReadOnly, dbReadOnly)
 
    If rs.RecordCount <> 0 Then 'ensure there are records in the table before proceeding
        With rs
            rs.MoveLast   'move to the end to ensure accurate recordcount value
            iRecCount = rs.RecordCount
            'iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1) 'Get Random Rec Number to use
            iRndRecNum = Int((iRecCount - 1 + 1) * Rnd(-(100000 * ID) * Time()))
            rs.MoveFirst
            .Move CLng(iRndRecNum)
            GetRndRec = ![Verb]
        End With
    End If
 
'Resume Error_Handler_Exit
    'On Error Resume Next
    'Cleanup
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Function
'
'Error_Handler:
'    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
'           "Error Number: " & Err.Number & vbCrLf & _
'           "Error Source: GetRndRec" & vbCrLf & _
'           "Error Description: " & Err.Description _
'           , vbOKOnly + vbCritical, "An Error has Occurred!"
'    Resume Error_Handler_Exit
End Function

 

[Micron]

You are using the Move method of a recordset when you probably should be using GoTo. If you're at record 7 out of 50 and you generate +45 as a random number, you're trying to move to record 7+45 or 52, which doesn't exist. Aside from that, it looks like there is a lot of unnecessary code, but maybe I don't have the whole picture.

To me, cmd is a prefix for a command button, which has no value. Perhaps it is a combo, in which case I'm not seeing the need for a Select Case block (btw, you should not have spaces or special characters, save for perhaps underscore, in object names) because it looks like the combo (?) value is the same as the table name. That makes sense, aside from the choice of names, so why not just use what the combo returns? You also seem to have an extra dbReadOnly in there. I also don't think you need the second procedure at all. Can you not just use the Rnd function and pass it to GoTo (rather than Move)? Once you get this error sorted, what's preventing this code from choosing the same record more than once?

 

[Micron]

Edit to above. I'm now thinking that a recordset doesn't have a GoTo method. However, it does have a FindFirst method which I'm thinking would require that the recordset have a numeric field with values to id the records. You could generate the random number and FindFirst that value to get the verb. Alternatively, there is this method that uses MoveNext. However, the recordset needs to be rebuilt after each pass of the code if you don't want to land on the same record in a session. For that I'd have a checkbox field in the table as a flag. When the verb is chosen, update the flag field to True so that the rebuilt recordset ignores it. When the form opens or closes (there is a form, right?) set all checkboxes to False for next time.

 

[mikenelena]

I've corrected several of the issues that you identified, and I think I'm getting closer, but a new issue has come up with my DLookup. It doesn't throw any errors, but it doesn't return a value either. I can't test further until I resolve that issue. Any ideas? I most appreciate your help! Thanks!!

Private Sub cmdBegin_Click()

    Dim db          As DAO.Database
    Dim rs          As DAO.Recordset
    Dim tblName     As String   'Table to pull random record from
    Dim iRecCount   As Long     'Number of record in the table
    Dim iRndRecNum  As Integer
    Dim CurrentVerb As String
    Dim Stem As String
    Dim Stem1 As String
    Dim Stem2 As String
    Dim VerbCode As String
    Dim MyVerb As String
    Dim Verb As String
    
tblName = Me.cmdVerbType [B][COLOR=rgb(44, 130, 201)]<--------------------------------------------------------------Unnecessary Select Case statements removed.[/COLOR][/B]

Set db = CurrentDb()
Set rs = db.OpenRecordset(tblName, dbOpenSnapshot, dbReadOnly)
 
    If rs.RecordCount <> 0 Then 'ensure there are records in the table before proceeding
        With rs
            rs.MoveLast   'move to the end to ensure accurate recordcount value
            iRecCount = rs.RecordCount
            'iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1) 'Get Random Rec Number to use
            iRndRecNum = Int(iRecCount * Rnd + 1)
            'iRndRecNum = Int((iRecCount - 1 + 1) * Rnd(-(100000 * ID) * Time()))
            rs.MoveFirst
            .Move CLng(iRndRecNum) 
                                                                                          [COLOR=rgb(44, 130, 201)][B]<------------------------------------------------------------------------------------------Unnecessary function call removed.[/B][/COLOR]
            Me.CurrentVerb = DLookup("[Verb]", Me.cmdVerbType, "[ID] = " & iRndRecNum) <-------------------------------[B][COLOR=rgb(226, 80, 65)]This DLookup is not working for some reason.[/COLOR][/B] 
        End With
    End If
 
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & tblName & " SET [Used]= -1 WHERE [Verb]= '" & Me.CurrentVerb & "';"      [B][COLOR=rgb(44, 130, 201)]<----------------------------Added checkbox to table to avoid duplicating the same verbs[/COLOR][/B]
DoCmd.SetWarnings True
 
    rs.Close
    Set rs = Nothing
    Set db = Nothing

 

[mikenelena]

EDIT: I understand now that my DLookup is failing because my ID's do not begin with 1, and the random function is based on a number of records, not on the range of ID's. I'm working to get that corrected now...

I've corrected several of the issues that you identified, and I think I'm getting closer, but a new issue has come up with my DLookup. It doesn't throw any errors, but it doesn't return a value either. I can't test further until I resolve that issue. Any ideas? I most appreciate your help! Thanks!!

Private Sub cmdBegin_Click()

    Dim db          As DAO.Database
    Dim rs          As DAO.Recordset
    Dim tblName     As String   'Table to pull random record from
    Dim iRecCount   As Long     'Number of record in the table
    Dim iRndRecNum  As Integer
    Dim CurrentVerb As String
    Dim Stem As String
    Dim Stem1 As String
    Dim Stem2 As String
    Dim VerbCode As String
    Dim MyVerb As String
    Dim Verb As String
   
tblName = Me.cmdVerbType [B][COLOR=rgb(44, 130, 201)]<--------------------------------------------------------------Unnecessary Select Case statements removed.[/COLOR][/B]

Set db = CurrentDb()
Set rs = db.OpenRecordset(tblName, dbOpenSnapshot, dbReadOnly)
 
    If rs.RecordCount <> 0 Then 'ensure there are records in the table before proceeding
        With rs
            rs.MoveLast   'move to the end to ensure accurate recordcount value
            iRecCount = rs.RecordCount
            'iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1) 'Get Random Rec Number to use
            iRndRecNum = Int(iRecCount * Rnd + 1)
            'iRndRecNum = Int((iRecCount - 1 + 1) * Rnd(-(100000 * ID) * Time()))
            rs.MoveFirst
            .Move CLng(iRndRecNum)
                                                                                          [COLOR=rgb(44, 130, 201)][B]<------------------------------------------------------------------------------------------Unnecessary function call removed.[/B][/COLOR]
            Me.CurrentVerb = DLookup("[Verb]", Me.cmdVerbType, "[ID] = " & iRndRecNum) <-------------------------------[B][COLOR=rgb(226, 80, 65)]This DLookup is not working for some reason.[/COLOR][/B]
        End With
    End If
 
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE " & tblName & " SET [Used]= -1 WHERE [Verb]= '" & Me.CurrentVerb & "';"      [B][COLOR=rgb(44, 130, 201)]<----------------------------Added checkbox to table to avoid duplicating the same verbs[/COLOR][/B]
DoCmd.SetWarnings True
 
    rs.Close
    Set rs = Nothing
    Set db = Nothing

 

[mikenelena]

I was thinking that I could find the Min and Max of the ID numbers, but with no guarantee that all of them will exist in a sequence, I'm not sure how Min/Max would help. For now I've renumbered the auto-number field from 1 to 342.

Now that I have a checkbox to indicate that a verb has been used in a particular game session, what code would I change to make sure that the random number doesn't select the same verb again?

Thanks,
Mike

 

[Micron]

I wrote the "air code" below this morning on the premise that
- there would be a checkbox field in the table to remove the record from consideration
- that there should be no repeat selection of a record (setting Flag field to True removes record from modified sql statement)
- that if you are on the last record that the loop should not execute but simply use the record you're on. This would be true if you were on the last record and there are still other records, or just one left
I only mention that the flags need to be set to False. That is for another procedure; perhaps form open or close or even button click. A reset button would allow you to close out and remain with the un-chosen records so as to be able to pick up where you left off, so to speak.

Function GetRandomVerb()As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim tbl As String, Dim strSql As String
Dim iRndRecNum As Integer, iRecCount As Integer

On Error GoTo errHandler

tbl = Me.cmdVerbType
strSql = "SELECT * FROM " & tbl & " WHERE Flag = False"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSql)

iRecCount = rs.RecordCount
If iRecCount > 0 Then
  rs.MoveLast
Else
  MsgBox "No records were returned."
  Set db = Nothing
  Set rs = Nothing
  Exit Function
End If

iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1)

'If Rnd=5,recs=5 we want to move from 4 to 5 else will err
'If Rnd=1,recs=1 we don't want to move. For/Next will not loop when To < i
If iRndRecNum = iRecCount Then iRndRecNum = iRndRecNum - 1
rs.MoveFirst
For i = 1 To iRndRecNum
  rs.MoveNext
Next

GetRandomVerb = rs.Fields("verb")
With rs
  .Edit
  !Flag = True
  .Update
End With

exitHere:
Set db = Nothing
Set rs = Nothing
Exit Function

errHandler:
Msgbox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Function

Again, this is untested. Change Flag, etc. to suit your situation. I still don't know what is providing the table name, nor do I know how you intend to call the function. In case you don't know, it is meant to be called and user somehow deals with the returned value. A repeat of that call should present another value.
HTH

Where are those html type bits in your posts coming from?

 

[mikenelena]

I wrote the "air code" below this morning on the premise that
- there would be a checkbox field in the table to remove the record from consideration
- that there should be no repeat selection of a record (setting Flag field to True removes record from modified sql statement)
- that if you are on the last record that the loop should not execute but simply use the record you're on. This would be true if you were on the last record and there are still other records, or just one left
I only mention that the flags need to be set to False. That is for another procedure; perhaps form open or close or even button click. A reset button would allow you to close out and remain with the un-chosen records so as to be able to pick up where you left off, so to speak.

Function GetRandomVerb()As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim tbl As String, Dim strSql As String
Dim iRndRecNum As Integer, iRecCount As Integer

On Error GoTo errHandler

tbl = Me.cmdVerbType
strSql = "SELECT * FROM " & tbl & " WHERE Flag = False"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSql)

iRecCount = rs.RecordCount
If iRecCount > 0 Then
  rs.MoveLast
Else
  MsgBox "No records were returned."
  Set db = Nothing
  Set rs = Nothing
  Exit Function
End If

iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1)

'If Rnd=5,recs=5 we want to move from 4 to 5 else will err
'If Rnd=1,recs=1 we don't want to move. For/Next will not loop when To < i
If iRndRecNum = iRecCount Then iRndRecNum = iRndRecNum - 1
rs.MoveFirst
For i = 1 To iRndRecNum
  rs.MoveNext
Next

GetRandomVerb = rs.Fields("verb")
With rs
  .Edit
  !Flag = True
  .Update
End With

exitHere:
Set db = Nothing
Set rs = Nothing
Exit Function

errHandler:
Msgbox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Function

Again, this is untested. Change Flag, etc. to suit your situation. I still don't know what is providing the table name, nor do I know how you intend to call the function. In case you don't know, it is meant to be called and user somehow deals with the returned value. A repeat of that call should present another value.
HTH

Where are those html type bits in your posts coming from?

I'm going to try your code when I'm back at the computer later today. Thank you very much for putting so much effort into helping me. To answer the questions you asked, the table name is provided by the value in a combo box. Those html bits came from me editing the posted code with the site tools to call attention to specific lines. (I guess maybe those text manipulation tools aren't meant to be used on code.) I have added a Yes/No field for flagging as you recommended.

As for the function... I originally had a function call, but misunderstood your original message to have meant that I didn't need it. By way of explaining, the game opens to a form with buttons for "Begin" "Pass", and "Continue". Only "Begin" is active when the game starts. When clicked, "Begin" presents the first verb. At that point, the button for "Pass" is activated, and "Begin" is deactivated. The user will enter the conjugation, then click another button, "Verify", which determines whether the responses are correct or incorrect. At that point, the button "Continue" is activated.

So, we have 3 command buttons that all essentially call the function in the same way. The difference lies in other things associated with those button clicks. (Mainly scoring.)

Let me try to incorporate your code suggestion and then see where things stand at that point.

Thanks again!!
...Mike

 

[Micron]

Being intrigued, I've been working on this. The fact that you can't upload files here and are not allowed to post a link to such files, etc. etc. is a real pain. So you will have to be content with pics and words. As for the function comment, I meant you didn't need both sub and function. You should be able to adapt if you choose to use. BTW, there are 2 errors in the previous code. I can at least say that this is all tested and I think it does what you want, but I've only tested with one table.
I'm not sure which of your 2 Rnd expressions would be the best. I went with the first one.

Form:

textboxes: textbox name: txtVerb; textbox name: txtRemaining
combobox: cmbLanguage
buttons & event name (see codes below)
cmdCloseEvent: cmdClose_OnClick()
cmdResetEvent: cmdReset_OnClick()
cmdGetVerbEvent: cmdGetVerb_OnClick()

Table:

Function GetRandomVerb(tbl As String) As String
'called by cmdGetVerb click event

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSql As String
Dim iRndRecNum As Integer, iRecCount As Integer, i As Integer

On Error GoTo errHandler

strSql = "SELECT * FROM " & tbl & " WHERE Flag = False"
'Debug.Print strSql
Set db = CurrentDb
Set rs = db.OpenRecordset(strSql)

iRecCount = rs.RecordCount
If iRecCount > 0 Then
  rs.MoveLast
  iRecCount = rs.RecordCount
Else
  MsgBox "No records were returned." & vbCrLf & "List may need refreshing."
  Set db = Nothing
  Set rs = Nothing
  Exit Function
End If

iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1)

'If Rnd=5,recs=5 we want to move from 4 to 5 else will err, so subtract 1
'If Rnd=1,recs=1 we don't want to move. For/Next will not loop when To value < i
If iRndRecNum = iRecCount Then iRndRecNum = iRndRecNum - 1
rs.MoveFirst
For i = 1 To iRndRecNum
  rs.MoveNext
Next

GetRandomVerb = rs.Fields("verb")
With rs
  .Edit
  !Flag = True
  .Update
End With

Me.txtRemaining = iRecCount - 1

exitHere:
Set db = Nothing
Set rs = Nothing
Exit Function

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Function

Private Sub cmdClose_Click()
DoCmd.Close
End Sub

Private Sub cmdGetVerb_Click()
Me.txtVerb = GetRandomVerb(Me.cmbLanguage.Column(1))

End Sub

Private Sub cmdReset_Click()
Dim strSql As String

If IsNull(Me.cmbLanguage) Then
   MsgBox "No table selected for reset"
   Exit Sub
End If
strSql = "UPDATE " & Me.cmbLanguage.Column(1) & " SET Flag = False WHERE Flag = true"
'Debug.Print strSql
CurrentDb.Execute strSql, dbFailOnError
Me.txtVerb = Null
Me.txtRemaining = Null

End Sub

In-use views:

 

[mikenelena]

Micron,

Again, many thanks. It looks like while you were added the above, I was working to test, adapt and incorporate the air code you posted earlier. It is a lot cleaner, and easier to work with, that much is certain. (And I like using it as a function rather than having it repeated in several modules.) The only issue I have observed thus far is that it begins with the first first, and proceeds straight through the list. There is no randomness. I tried changing the commented line for the one below, but still no randomness. (I had read on other threads that the Rnd function in Access isn't, and that throwing the current system time into the calculation is a functional work around. But there must be something else in the code undermining the randomness.

'iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1)
iRndRecNum = Int((iRecCount - 1 + 1) * Rnd(-(100000 * ID) * Time()))

I will take a closer look at your most recent postings later this evening. Here are a couple of my own pics. In the Design View of the form you see the leftmost column of Unbound textboxes. These are hidden, and populate with the correctly conjugated verb forms through concatenation in other parts of my code.