Random picking

[Rick]

Hi,
I'm a teacher with a question database of hundreds of
questions in different catagories. What I want to do is
randomly pick a certain number of questions from each
catagorie for a test, any ideas how to do this?
Thanks

 

[Guest]

Add a field to your table labeled something like "SELECT", Data Type should be Yes/No and under the lookup tab, make the display control to be checkbox. Save the table and view it. You will be able to put a checkmark in the box shown for the test questions you desire to be included
Then create a select query where the only included records are the ones where "select" = True
Run that query and your selected test questions will be the only ones you see

 

[Alex Ivanov]

Try this:

Option Explicit

Sub test()
'Prints 10 out of 100 numbers
Dim TotalNumOfQuestions As Integer
Dim NumOfSamples As Integer
Dim MyArray() As Integer
Dim i As Integer
TotalNumOfQuestions = 100
NumOfSamples = 10
MyArray = GenerateArray(TotalNumOfQuestions, NumOfSamples)
For i = 0 To NumOfSamples - 1
Debug.Print MyArray(i);
Next
Debug.Print
End Sub

Function RandInt(MaxInt) As Integer
Dim x As Integer
x = Int(Rnd * MaxInt) + 1
RandInt = x
End Function

Function GenerateArray(TotalNumOfQuestions As Integer, _
NumOfSamples As Integer) As Integer()
Dim i As Integer, j As Integer
Dim tmp As Integer
Dim UniqueNumbers() As Integer
Dim NotUnique As Boolean
If TotalNumOfQuestions < NumOfSamples Then
Err.Raise vbObjectError + 1, "GenerateArray", _
"Can't create unique numbers"
Exit Function
End If
ReDim UniqueNumbers(NumOfSamples - 1)
For i = 0 To NumOfSamples - 1
tmp = RandInt(TotalNumOfQuestions)
Do
NotUnique = False
For j = 0 To i - 1
If tmp = UniqueNumbers(j) Then
tmp = RandInt(TotalNumOfQuestions)
NotUnique = True
Exit For
End If
Next
Loop While NotUnique
UniqueNumbers(i) = tmp
Next
GenerateArray = UniqueNumbers
End Function

Alex.

 

[Alex Ivanov]

Did not post from the first time. Trying again.
Try this:

Option Explicit

Sub test()
'Prints 10 out of 100 numbers
Dim TotalNumOfQuestions As Integer
Dim NumOfSamples As Integer
Dim MyArray() As Integer
Dim i As Integer
TotalNumOfQuestions = 100
NumOfSamples = 10
MyArray = GenerateArray(TotalNumOfQuestions, NumOfSamples)
For i = 0 To NumOfSamples - 1
Debug.Print MyArray(i);
Next
Debug.Print
End Sub

Function RandInt(MaxInt) As Integer
Dim x As Integer
x = Int(Rnd * MaxInt) + 1
RandInt = x
End Function

Function GenerateArray(TotalNumOfQuestions As Integer, _
NumOfSamples As Integer) As Integer()
Dim i As Integer, j As Integer
Dim tmp As Integer
Dim UniqueNumbers() As Integer
Dim NotUnique As Boolean
If TotalNumOfQuestions < NumOfSamples Then
Err.Raise vbObjectError + 1, "GenerateArray", _
"Can't create unique numbers"
Exit Function
End If
ReDim UniqueNumbers(NumOfSamples - 1)
For i = 0 To NumOfSamples - 1
tmp = RandInt(TotalNumOfQuestions)
Do
NotUnique = False
For j = 0 To i - 1
If tmp = UniqueNumbers(j) Then
tmp = RandInt(TotalNumOfQuestions)
NotUnique = True
Exit For
End If
Next
Loop While NotUnique
UniqueNumbers(i) = tmp
Next
GenerateArray = UniqueNumbers
End Function

Alex.