Here is the revised procedure which now includes output to a table. The table is named GroupPCTS
It is created each time this procedure is executed. If the table already exists, it will be deleted and a new table created.
Code:
'---------------------------------------------------------------------------------------
' Procedure : RandOfEachGroup
' Author : Jack
' Date : 19/03/2014
' Purpose : Get Random 5% sample of records by ESRInitials group.
' Output the results to a table called GroupPCTS.
'---------------------------------------------------------------------------------------
'
Sub RandOfEachGroup()
'************ SQL FOR ********************
'************ QryRandOrigCountsByGroup ********************
'SELECT Randomm.ESRInitials, Count(Randomm.rID) AS CountOfrID
'FROM Randomm
'GROUP BY Randomm.ESRInitials;
'
'***********************************************************
'
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsList As DAO.Recordset
Dim rsOut As DAO.Recordset
Dim i As Integer 'counter of records in group
Dim sESRInitials As String
Dim sql As String
Dim createTableSQL As String 'sql to create a table ** each time program is executed
Dim deleteTableSQL As String
10 deleteTableSQL = "Drop Table GroupPCTS"
20 createTableSQL = "CREATE Table GroupPCTs( MyId autoincrement PRIMARY KEY," _
& " ESRInits text(20), Rid Long, RandomId Long, xtrafield double);"
30 Set db = CurrentDb
'Table for output of Group percentages
40 On Error Resume Next 'prevent error when deleting table
50 db.Execute deleteTableSQL, dbFailOnError
60 db.Execute createTableSQL, dbFailOnError
70 On Error GoTo RandOfEachGroup_Error 'reset proper error handling
80 Set rs = db.OpenRecordset("QryRandOrigCountsByGroup")
90 Set rsOut = db.OpenRecordset("GroupPCTS")
100 With rs
110 Do While Not .EOF
120 i = 0
130 sql = "select ESRinitials,rid,xtrafield,randomID from randomm where xtrafield " _
& "IN (select top 5 percent xtrafield from Randomm where " _
& " ESrInitials = '" & Trim$(!ESRinitials) & "') order by xtrafield " 'Randomized by group
140 Set rsList = db.OpenRecordset(sql)
150 Do While Not rsList.EOF
160 i = i + 1
'This is being written to a tableGroupPCTS
170 rsOut.AddNew
180 rsOut!ESRInits = rsList!ESRinitials
190 rsOut!rid = rsList!rid
200 rsOut!RandomID = rsList!RandomID
210 rsOut!xtrafield = rsList!xtrafield
220 rsOut.Update
'comment out this debug line if it isn't needed.
230 Debug.Print vbTab & rsList!ESRinitials & " " & rsList!rid & " " _
& rsList!RandomID & " " & rsList!xtrafield
240 sESRInitials = rsList!ESRinitials
250 rsList.MoveNext
260 Loop
270 .MoveNext
'this debug line can be commented out if it isn't needed.
280 Debug.Print sESRInitials & " Count: " & i
290 Loop
300 End With
310 rsOut.Close
320 rsList.Close
330 rs.Close
340 MsgBox " Finished Determining and Creating Table GroupPCTS" & vbCrLf & vbTab & " Random 5 % by Group", vbOKOnly
350 On Error GoTo 0
360 Exit Sub
RandOfEachGroup_Error:
370 MsgBox "Error " & Err.number & " on line " & Erl & " (" & Err.Description & ") in procedure RandOfEachGroup of Module AWF_Related"
End Sub
Good luck with your project.
Query to pull a percentage of records by user
Windows 7 64bit 
Access 2010 64bit
Reply With Quote
