Select specific number of records and randomise

[fraser_lindsay]

Hi,

I have a fairly basic database of exam questions I have put together.

I have a form bound to a query with all questions.

On that form I have a text box for the user to enter the number of questions they want.

I generate the exam paper based on a combo selection, some options and either all questions or the user input number of questions.

How do I get the DB to only pull the specific number of records requested (e.g. 20 questions) and randomise them from the full data set?

Thanks,

Fraser

 

[DCrake]

In laymans terms I would create a function that picks n number of random numbers based on a value passed to the function and places them in one long string with , delimiters so the end result would be something like

1,21,23,6,19,51

Then in your underlying query you would call the function in the condition section, such as: In(GetRandomQuestions())

To make it work you would have a public variable declared in a module

Public qCount as integer

Then in your form you ask the user to input the number of questions. Then on the after update of the control pass this value to the qCount.

qCount = Me.TxtHowmany

Your function GetRandomQuertions() would return this value to the query

Public Function GetRandomQuestions(nIndex As Integer) As String

Dim strItems As String

For n = 1 To nIndex
strItems = strItems & "," & "Random number generater code here"
Next

'Drop the last comma from the string here

Pass the strItems back to the user

GetRandomQuestions = strItems

End Function


In(1,21,23,6,19,51) Where the list of numbers is translated from strItems

This is all aircode and simplified for brevity but it should give you a good idea of how to do it.

Remember when generating the random numbers to make sure each number is unique to the list and is in the range between 1 and total questions available.

David



In essence your query condition would be an In() request

 

[fraser_lindsay]

David,

Thanks for the pointers, once again. I am making some progress (I think).

I have created a function called 'RandomMCQQuestions':

Public Function RandomMCQQuestions(nIndex As Integer) As String

Dim strItems As String
For n = 1 To nIndex
strItems = strItems & "," & "Random number generator code here"
Next
'Drop the last comma from the string here

'Pass the strItems back to the user
RandomMCQQuestions = strItems

End Function

I have edited the form module like so:

Inserted

Public qCount As Integer

at the start of the code module for the form - is that what you meant?
Then edited the afterupdate to update qcount by inserting this:

qCount = Me.txtMCQnumber

As you can see my function isn't quite right. I have found some code for a randomiser that Mile-O-Phile created a while back and put onto the forum, but I'm not sure exactly how to use it. My earlier attempts were unsucessful.

Public Sub RandomPick(ByRef intRecords As Integer)
 
    'On Error GoTo Err_RandomPick
 
    ' Author: Mile-O-Phile
    ' History: 07-Nov-2002 - Initially written
    ' Discussion: Selects five random numbers without duplication
    '             In order to select five random records from a recordset, we must first decide which
    '             records we are going to take from the recordset.

    Dim intCounterA As Integer, intCounterB As Integer ' Loop counters
    Dim intRandom(1 To 1000) As Integer ' Store for accepted numbers
    Dim intCurrent As Integer ' The current random number
    Dim intPosition As Integer ' Holds our position in the array
    Dim booUnusable As Boolean ' Determines whether number is a duplicate
    
    intPosition = 1

    For intCounterA = 1 To 1000
        ' This ensures we get a random number within our given range
        intCurrent = Int(Rnd() * intRecords) + 1
        
        ' Next, we must check that the number we have just selected doesn't match any others
        For intCounterB = 1 To 1000
            If (intCurrent = intRandom(intCounterB)) Then
                booUnusable = True
                Exit For
            End If
            
            If (intRandom(intCounterB) = 0) Then
                ' There will only be a zero value in the array if no value has been entered
                ' in intRandom(?) for that index so it can be safely left if a zero is seen
                Exit For
            End If
        Next intCounterB ' return the counter
        
        While booUnusable
            ' If the number generated is a duplicate then the routine should continue generating random
            ' numbers until there is a useable value
            booUnusable = False
            intCurrent = Int(Rnd() * intRecords) + 1
            For intCounterB = 1 To 1000
                ' Again, the number must be checked to determine whether it is a duplicate
                If (intCurrent = intRandom(intCounterB)) Then
                    booUnusable = True
                    Exit For
                End If
            Next intCounterB ' return the counter
        Wend
        ' If a useable number is achieved then the search for that array index is considered to be complete
        intRandom(intPosition) = intCurrent
        intPosition = intPosition + 1 ' increment the array index
    Next intCounterA ' return the counter
    
    Call MakeRandomTable(intRandom())
    
Exit_RandomPick:
    Exit Sub
    
Err_RandomPick:
    MsgBox Err.Number & ": " & Err.Description, vbExclamation, "Error in Sub RandomPick"
    Resume Exit_RandomPick
    
End Sub

So I have tried this - but I can't quite get it to compile yet. I have defined 'intRecords' apparently - problem being I have no clue what it actually is to define it.

Public Function RandomMCQQuestions(nIndex As Integer) As String

Dim strItems As String
Dim intCounterA As Integer, intCounterB As Integer ' Loop counters
Dim intRandom(1 To 1000) As Integer ' Store for accepted numbers
Dim intCurrent As Integer ' The current random number
Dim intPosition As Integer ' Holds our position in the array
Dim booUnusable As Boolean ' Determines whether number is a duplicate
    
    On Error GoTo Err_RandomMCQQuestions
    
    intPosition = 1

    For intCounterA = 1 To 1000
        ' This ensures we get a random number within our given range
        intCurrent = Int(Rnd() * intRecords) + 1
        
        ' Next, we must check that the number we have just selected doesn't match any others
        For intCounterB = 1 To 1000
            If (intCurrent = intRandom(intCounterB)) Then
                booUnusable = True
                Exit For
            End If
            
            If (intRandom(intCounterB) = 0) Then
                ' There will only be a zero value in the array if no value has been entered
                ' in intRandom(?) for that index so it can be safely left if a zero is seen
                Exit For
            End If
        Next intCounterB ' return the counter
        
        While booUnusable
            ' If the number generated is a duplicate then the routine should continue generating random
            ' numbers until there is a useable value
            booUnusable = False
            intCurrent = Int(Rnd() * intRecords) + 1
            For intCounterB = 1 To 1000
                ' Again, the number must be checked to determine whether it is a duplicate
                If (intCurrent = intRandom(intCounterB)) Then
                    booUnusable = True
                    Exit For
                End If
            Next intCounterB ' return the counter
        Wend
        ' If a useable number is achieved then the search for that array index is considered to be complete
        intRandom(intPosition) = intCurrent
        intPosition = intPosition + 1 ' increment the array index
    Next intCounterA ' return the counter
    
    'For n = 1 To nIndex 'not sure if I need this

    strItems = strItems & "," & intRandom
    Next
    'Drop the last comma from the string here

    'Pass the strItems back to the user
    RandomMCQQuestions = strItems

Exit_RandomMCQQuestions:
    Exit Sub
    
Err_RandomMCQQuestions:
    MsgBox Err.Number & ": " & Err.Description, vbExclamation, "Error in Sub RandomMCQQuestions"
    Resume Exit_RandomMCQQuestions

End Function

Sincerest apologies for the massive post and being a bit thick - am I barking up the wrong tree? It looks like random number generator code...