Need review of code to select random record from table

mikenelena

Board Regular
Joined
Mar 5, 2018
Messages
139
Office Version
  1. 365
Platform
  1. Windows
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!!

VBA Code:
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:
-------------------------------------------------------------------------------
VBA Code:
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
 
I don't think I'd worry about whether or not Rnd is truly random in this case because a used verb cannot be used again once the record has been flagged. Even if you generated 22 multiple times, it will point to a different record because the record population changes each time, so your first expression seems to work fine. To prove the point, I added a record ID textbox to see what the record ID was each time:
45 ; 40 ; 19 ; 50 ; 44 ; 4 ; 48 ; 18 ; 27 ; 37 ; 5 ; 30 ; 23 ; 15 ; 32 ; 33 ; 12 ; 14 ; 42 ; 41 ; 28;
In reality we don't care if the number is random, but if you use the same expression as me you can change code to put the rnd result in txtID for fun.
Not sure what you comment re: using function means. If you move it to a standard module, you cannot use Me as a reference thus will have to alter the code. I'm going to post this so I don't lose it, then look at your pics. If edit window times out and I need to comment, I'll add a post.

I also edited 2 procedures as follows:

VBA Code:
Private Sub cmdGetVerb_Click()
If Nz(Me.cmbLanguage, "") = "" Then '<<error was raised if no value chosen in combo
   MsgBox "Please select a Language"
   Exit Sub
End If
Me.txtVerb = GetRandomVerb(Me.cmbLanguage.Column(1))

End Sub
If you want to see the 'randomness' add txtID to the form and this to the function after
Me.txtRemaining = iRecCount - 1

Don't forget to comment out the Debug.
VBA Code:
Me.txtID = rs.Fields(0)
Debug.Print Me.txtID

EDIT - That looks quite impressive.
 
Upvote 0
Solution

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top