randomisation help - a new problem

[fluffyozzy]

Hi everyone,

My previous post (randomisation help for total beginner) and ByteMyzer's reply helped me so much, I feel compelled to present another problem to the community. I thought I may be able modify ByteMyzer's code to do something slightly different for this new problem but I'm obviously too new to VB to do this. Here is the problem:

I have an Orals table that contain oral questions and sample answers (71 questions overall). Orals table is connected to Principle table by PrincipleID. Each of the oral questions belong to a Principle. There are 7 different Principles. I need to randomly select different number of questions from each principle to produce 10 questions, then put these into a new table called OralRandom. More specifically:

1 random question from PrincipleID 1, 2, 3, 5, 6
2 random questions from PrincipleID 4
3 random questions from PrincipleID 7

I have the following code. At the moment, it only selects 7 random questions from the whole table.


------------

Public Function MakeOralRandomTable()

Dim intCounterA As Integer, intCounterB As Integer ' Loop Counters
Dim intPosition As Integer ' The current random number position
Dim rst As Recordset ' Recordset for Random Ranges
ReDim intRandom(0) As Integer ' Store for accepted numbers

Set rst = CurrentDb.OpenRecordset("SELECT Orals.PrincipleID, Min(Orals.OralID)AS MinOfOralID,Max(Orals.OralID) AS MaxOfOralID FROM Orals GROUP BY Orals.PrincipleID;")
' MinOfOralID - Low end of ID range for random selection per PrincipleID
' MaxOfOralID - High end of ID range for random selection per PrincipleID

Randomize

Do While Not rst.EOF
' Inflate the Random Array for new entry
ReDim Preserve intRandom(UBound(intRandom) + 1)
' Randomly select OralID in the given range for the current PrincipleID and store in Random Array
intRandom(UBound(intRandom)) = Int((rst!MaxOfOralID - rst!MinOfOralID + 1) * Rnd + rst!MinOfOralID)
rst.MoveNext
Loop

rst.Close

' Clear the OralRandom table for new entries
CurrentDb.Execute "DELETE * FROM OralRandom;"

For intCounterA = 1 To 7
' Select Random position within the Random Array
intPosition = Int(UBound(intRandom) * Rnd + 1)
' Fetch OralID from the Random Array, select matching record from Orals
' and append to OralRandom
CurrentDb.Execute "INSERT INTO OralRandom SELECT Orals.* FROM Orals WHERE Orals.OralID=" & intRandom(intPosition) & ";"
' Remove selected OralID from the Random Array and deflate by 1
' to prevent duplicate selections
For intCounterB = intPosition To UBound(intRandom) - 1
intRandom(intCounterB) = intRandom(intCounterB + 1)
Next intCounterB
ReDim Preserve intRandom(UBound(intRandom) - 1)
Next intCounterA

End Function

---------------

I hope this is clear and again, I would really appreciate your good help on helping me modify this code. Thank you in advance. If it all works, I think I'll submit an example database to the Sample Database thread, seems to me, there may be other people out there who would benefit from these codes.

 

[ByteMyzer]

Ahh, this is SLIGHTLY more involved. Try this modified MakeOralRandomTable Sub:

Public Function MakeOralRandomTable()

Dim intCounterA As Integer, intCounterB As Integer ' Loop Counters
Dim intPosition As Integer ' The current random number position
Dim rst As Recordset ' Recordset for Random Ranges
ReDim intRandom(0) As Integer ' Store for accepted numbers

Set rst = CurrentDb.OpenRecordset("SELECT Orals.PrincipleID, Min(Orals.OralID)AS MinOfOralID,Max(Orals.OralID) AS MaxOfOralID FROM Orals GROUP BY Orals.PrincipleID;")
' MinOfOralID - Low end of ID range for random selection per PrincipleID
' MaxOfOralID - High end of ID range for random selection per PrincipleID

Randomize

Do While Not rst.EOF
    Select Case rst!PrincipleID
        Case 1, 2, 3, 5, 6
            intCounterB = 1
        Case 4
            intCounterB = 2
        Case 7
            intCounterB = 3
    End Select
    For intCounterA = 1 To intCounterB
        ' Inflate the Random Array for new entry
        ReDim Preserve intRandom(UBound(intRandom) + 1)
        ' Randomly select OralID in the given range for the current PrincipleID and store in Random Array
Loop_Random:
        intRandom(UBound(intRandom)) = Int((rst!MaxOfOralID - rst!MinOfOralID + 1) * Rnd + rst!MinOfOralID)
        If intCounterA > 1 Then
            For intPosition = UBound(intRandom) - intCounterA + 1 To UBound(intRandom) - 1
                If intRandom(intPosition) = intRandom(intCounterA) Then Exit For: GoTo Loop_Random
            Next intPosition
        End If
    Next intCounterA
    rst.MoveNext
Loop

rst.Close

' Clear the OralRandom table for new entries
CurrentDb.Execute "DELETE * FROM OralRandom;"

For intCounterA = 1 To 10
    ' Select Random position within the Random Array
    intPosition = Int(UBound(intRandom) * Rnd + 1)
    ' Fetch OralID from the Random Array, select matching record from Orals
    ' and append to OralRandom
    CurrentDb.Execute "INSERT INTO OralRandom SELECT Orals.* FROM Orals WHERE Orals.OralID=" & intRandom(intPosition) & ";"
    ' Remove selected OralID from the Random Array and deflate by 1
    ' to prevent duplicate selections
    For intCounterB = intPosition To UBound(intRandom) - 1
        intRandom(intCounterB) = intRandom(intCounterB + 1)
    Next intCounterB
    ReDim Preserve intRandom(UBound(intRandom) - 1)
Next intCounterA

End Function

 

[fluffyozzy]

ByteMyzer,

You are my GOD!! It's working and it's perfect!! Thank you very much. (I have so much to learn...)

I think I'm going to make a sample database using Mile-O-Phile's example of capitals of various cities (I hope he won't mind me using his data set) and use these fantastic codes you have produced for me and post it at the Sample Database section (if that's okay with you). I'm sure other good people of this board will find these very useful as working examples. I will, of course, give you full credit for these codes

Thanks again a million times. You have just saved my brain cells from exploding trying to learn VB to save a time-pressured project. I couldn't have done it without you

 

[ByteMyzer]

Hey, all of us "gurus" have had our struggles with learning solutions to these logic puzzles ourselves at one time or another; I can fully relate.

By all means, you have my permission to post the codes; They are all original, written by me, and should also serve as a small example of the type of access application code I develop. (No, I don't do them all for free). Once again, I'm glad this worked for you.