Populate Controls Randomly from Access Database

[tjbvo]

Greetings

I am busy with a program that randomly selects data from a databse and then populates controls with the random data. the user must then select an option that must be stored for printing at the end of the program.

Below I have pasted my code. I am using VB6 and MSAccess Database.

Thanking You in Advance.

Julian

ps. I am a beginner

Option Explicit
Dim CN As ADODB.Connection
Public RS As ADODB.Recordset
Dim i As Long
Dim strArray(5) As Long
Dim x As Long
Dim z As Long
Dim WordCounter As Long
Dim CurrentWord As Long
Dim SQL As String
 
Private Sub OpenConnection()
 
Set CN = New ADODB.Connection
CN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\cas.mdb"
CN.Open
 
End Sub
 
Private Sub ReturnRecords()
 
Set RS = New ADODB.Recordset
 
OpenConnection
 
With RS
    .ActiveConnection = CN
    .Source = "SELECT * FROM [caslit]"
    .CursorType = adOpenStatic
    .LockType = adLockOptimistic
    .Open
End With
 
End Sub
 
Private Sub cmdNext_Click()
 
Test    'jumps to sub. to generate the next question
 
lblStatus.Caption = RS.AbsolutePosition & "  of  " & RS.RecordCount
 
End Sub
 
Private Sub Form_Load()
 
ReturnRecords
 
lblDate.Caption = Date
 
lblTime.Caption = Time
 
'Test
 
Finder
 
lblStatus.Caption = RS.AbsolutePosition & "  of  " & RS.RecordCount
 
End Sub
 
Private Sub Form_Paint()
 
Dim wid As Single
Dim hgt As Single
Dim x As Single
Dim y As Single
 
    wid = Picture1.ScaleWidth
    hgt = Picture1.ScaleHeight
    y = 0
    Do While y < ScaleHeight
        x = 0
        Do While x < ScaleWidth
            PaintPicture Picture1.Picture, _
                x, y, wid, hgt
            x = x + wid
        Loop
        y = y + hgt
    Loop
 
End Sub
 
Private Sub mnuExit_Click()
 
Set CN = Nothing
Set RS = Nothing
 
Load frmIndex
frmIndex.Show
 
Unload Me
 
End Sub
 
Private Sub Test()
 
Dim RndNum As Long
Dim strCount As Long
 
For i = 0 To 5
If strCount = 1 Then
i = i - 1
strCount = 0
End If
strCount = 0
Randomize
RndNum = Int((5 * Rnd) + 1)
 
    x = 0
    For x = 0 To i
 
        If strArray(x) = RndNum Then
        strCount = 1
 
        End If
 
    Next x
 
    If strCount < 1 Then
        strArray(i) = RndNum
        strCount = 0
 
    End If
 
Next i
 
'Call Finder
 
End Sub
 
Private Sub Finder()
 
Call Test
 
WordCounter = 5
 
'create
SQL = "SELECT * FROM caslit WHERE indexid="
CurrentWord = 0
For z = 0 To WordCounter - 1
If z <> WordCounter - 1 Then
SQL = SQL & "'" & strArray(z) & "' OR indexid="
CurrentWord = CurrentWord + 1
ElseIf z = WordCounter - 1 Then
SQL = SQL & "'" & strArray(z) & "'"
End If
Next z
 
lblQuestion.Caption = RS!question
OptA1.Caption = RS!c1
OptA2.Caption = RS!c2
OptA3.Caption = RS!c3
OptA4.Caption = RS!c4
 
End Sub

[willakawill]

Hi. This is a lot of code. You have not posted a clear question. Which part of your code is not working? What, specifically, are you stuck on?

[tjbvo]

Hi. This is a lot of code. You have not posted a clear question. Which part of your code is not working? What, specifically, are you stuck on?

[quote=tjbvo] Hi. Apologies.

The code "Private Sub Test()" is to do the random selection, and also to eliminate any duplicates.

The code "Private Sub Finder()" is to randomly select the data from the database.

However, when the cmdNext button is clicked, nothing happens. It is supposed to display the next random data in the lblQuestion, optA1, optA2, optA3 and optA4 fields/controls.

These are the only "Subs" that are giving me problems.

Thanking You for your help in Advance.
Julian

[quote]

[willakawill]

Hi Julian
So it looks like your problem is in this snippet:

Private Sub Test()
 
    Dim RndNum As Long
    Dim strCount As Long
 
    For i = 0 To 5
 
        If strCount = 1 Then
            i = i - 1
            strCount = 0
        End If
 
        strCount = 0
        Randomize
        RndNum = Int((5 * Rnd) + 1)
 
        For x = 0 To i
 
            If strArray(x) = RndNum Then
                strCount = 1
            End If
 
        Next x
 
        If strCount < 1 Then
            strArray(i) = RndNum
            strCount = 0
        End If
 
    Next i
 
End Sub

Copy this code and put comments all the way through saying what the different lines are for and what you want to do.

[tjbvo]

Hi Julian
So it looks like your problem is in this snippet:

Private Sub Test()
 
    Dim RndNum As Long
    Dim strCount As Long
 
    For i = 0 To 5
 
        If strCount = 1 Then
            i = i - 1
            strCount = 0
        End If
 
        strCount = 0
        Randomize
        RndNum = Int((5 * Rnd) + 1)
 
        For x = 0 To i
 
            If strArray(x) = RndNum Then
                strCount = 1
            End If
 
        Next x
 
        If strCount < 1 Then
            strArray(i) = RndNum
            strCount = 0
        End If
 
    Next i
 
End Sub

Copy this code and put comments all the way through saying what the different lines are for and what you want to do.

[quote=tjbvo]
Greetings

I have placed comments in both subs.

Hope this will be of help.


Private Sub Test()

Dim RndNum As Long ' declare variable
Dim strCount As Long ' declare variable

For i = 0 To 5 ' setup count
If strCount = 1 Then ' setup initial start point
i = i - 1 ' reduce start point by one
strCount = 0 ' setup actual start point in database
End If ' end setup
strCount = 0 ' confirm database start point
Randomize ' invoke random function
RndNum = Int((5 * Rnd) + 1) ' setup random function for return of data

x = 0 ' setup an array
For x = 0 To i ' declare array values

If strArray(x) = RndNum Then ' start of array
strCount = 1 ' confirm that array has a value

End If

Next x ' next array value

If strCount < 1 Then ' find value of array
strArray(i) = RndNum ' confirm that array value in not duplicate
strCount = 0 ' if array is duplicate set value to 0. force new random array value

End If

Next i ' next non duplicate array value

'Call Finder ' here i have commented out the next sub as i was having problems.
' this call statement will not be active as i was just testing the
' sub by calling the next sub procedure directly from here.

End Sub

Private Sub Finder()

Call Test ' calling the previous sub procedure

WordCounter = 5 ' setting of limit of variable

'create
SQL = "SELECT * FROM caslit WHERE indexid="
CurrentWord = 0 ' setting of initial value
For z = 0 To WordCounter - 1 ' declaring value of variable
If z <> WordCounter - 1 Then ' establishing value of variable
SQL = SQL & "'" & strArray(z) & "' OR indexid="
CurrentWord = CurrentWord + 1 ' setting value of variable
ElseIf z = WordCounter - 1 Then ' if value of variable is nothing then get next value
SQL = SQL & "'" & strArray(z) & "'"
End If
Next z ' return next value from database

lblQuestion.Caption = RS!question ' display value returned from database
OptA1.Caption = RS!c1 ' display value returned from database
OptA2.Caption = RS!c2 ' display value returned from database
OptA3.Caption = RS!c3 ' display value returned from database
OptA4.Caption = RS!c4 ' display value returned from database

End Sub

ps. In the sub "Finder" must the "next z" be before or after the display controls ?

Thanks for your assistance in advance

Julian
[quote]