Hello,
I have a form (frmRandomSampling) where the user selects how many Sample (txtSample) they would like to run. Then they select "Run Report".
![]()
Table below (tblEmployeeProduction) indicates "Employee ID” and “Item Number”
![]()
This is the coding that I am using, it will pull proper sample for the department but not for each employee for that department. Let say the user select 2 sample it will pull 2 samples for the department instead of 2 samples for each employee with in that
department.
I am not a programmer, can you help with the coding?
Thank you and have a good day!
Private Sub BuildRandomTable()
Dim dbsRandom As Database
Dim rstRequest As Recordset
Dim rstRandom As Recordset
Dim UpperLimit As Long
Dim LowerLimit As Long
Dim lngCounter As Long
Dim lngGuess As Long
Dim lngRequest As Long
Dim lngRecordCount As Long
' This module is in the Current database.
Set dbsRandom = CurrentDb
' Open table recordset.
Set rstRequest = dbsRandom.OpenRecordset("tblEmployeeProduction")
rstRequest.MoveFirst
LowerLimit = rstRequest!ID
rstRequest.MoveLast
UpperLimit = rstRequest!ID
lngRecordCount = rstRequest.RecordCount
' Build Random table
Set rstRandom = dbsRandom.OpenRecordset("tblRandom", dbOpenDynaset)
lngCounter = 1
' Check to make sure the number of
' records requested is reasonable.
If lngRequest > lngRecordCount Then
MsgBox "Request is greater than the total number of records."
Exit Sub
Else
'lngRequest = lngRequest + 1
lngRequest = Form_frmRandomSampling.txtSample + 1
End If
Randomize
Do Until lngCounter = lngRequest
' Generate a random number
lngGuess = Int((UpperLimit - LowerLimit + 1) * Rnd + LowerLimit)
' Ensure that it exists in the Orders table.
rstRequest.Index = "PrimaryKey"
rstRequest.Seek "=", lngGuess
If rstRequest.NoMatch Then
' Drop through and generate a new number.
Else
' Check to see if it's already been used in the new table.
rstRandom.FindFirst "lngOrderNumber =" & lngGuess
' If not, add it to the new table.
If rstRandom.NoMatch Then
With rstRandom
.AddNew
!lngGuessNumber = lngCounter
!lngOrderNumber = lngGuess
.Update
End With
lngCounter = lngCounter + 1
End If
End If
Loop
' Clean up.
dbsRandom.Close
End Sub
Jay