strive4peace

If you like my Random Picker, please donate so I can keep on charing what I develop for free.
thank you





Have you ever wanted to be able to pick a random record?
Now it is easy! All you need is ONE form: f_RANDOM_PICKER
all the necessary code is behind the form.

watch! 2015 Microsoft MVP Virtual Conference on Channel 9 (MSDN) for Access
53 minute presentation
Access Basics Video Tutorials Learn VBA ListFiles Database Random Picker Error Handling Reference Database Whistles & Bells Help Examples Crystal's Analyzer Code Documenter

Quick Jump To Sections

Random Picker Download, Instructions, Comments, and Code


Download Database with Random Picker form in ACCDB format

DB_RandomPicker_Crystal_110602__ACCDB_TXT_PNGs.zip

The Random Picker form may be freely distributed. If you are selling an application and wish to incorporate code or ideas from my Random Picker form or code, you will need to obtain written permission from me.

contents:
  • DB_RandomPicker_Crystal_110602.accdb
    database in Access 2007 format with the f_RANDOM_PICKER form, a sample table, and sample queries. The form is all you need to import (and compile) into another database to run the Random Picker.

  • PNG files
    3 screenshots with notes

  • Form_f_RANDOM_PICKER_Crystal_110602.cls
    the code behind the Random Picker form (class module) — you can open this with NotePad or Word or another text editor.

  • ReadMe_RandomPicker~Crystal.txt
    text file with notes about the Random Picker
Go To Top           Quick Jump

Instructions

"How do you use the Random Picker?" It is as easy as 1,2,3 ...


1.

  • Unzip the attachment.
  • Import the form, f_RANDOM_PICKER, into your working database and open it

ribbon >> External Data >> Access >> Browse to DB_RandomPicker_Crystal_110416_630p.accdb and choose the form, f_RANDOM_PICKER

there are 2 sample queries and one sample table in the database as well, but you do not need to import them ... you will use your data :)




2.

Pick a Table or Query




3.

click the Pick a Winner command button



Go To Top           Quick Jump

Random Picker Code


		
Option Compare Database
Option Explicit
'
' written by Crystal as an example for
' http://www.youtube.com/watch?v=ToSv1v1FY5A
'
' all code to choose a random record from any table or query is here
'
' 1. choose a table or query from the Pick Data combobox
'
' the number of records will be displayed as the "## Contestants" label above the records,
' which are displayed in a datasheet, which is specified as the source of f_Subform
'
' 2. click the Pick a winner! command button
'

' Record will be selected on the subform
' and a msgbox will be displayed with the record number of the winner
'
' ========================================================================
   'Necessary Controls if you are building a form for the code
   '
   '   cbo_PickData      : combobox to choose a Table or Query
   '   f_subform         : subform control whose SourceObject property is changed to the table or query selected in cbo_PickData
   '   Label_Contestants : label control whose Caption ("Contestants") property is changed to show the number of records
   '   cmdPickWinner     : command button to pick a winner
   '   cmd_Close         : command button to close the form
   '
   'More Control Properties
   '
   ' cbo_PickData
   '
   ' RowSource -->
   '           SELECT mso.Name, mso.DateCreate, mso.DateUpdate, IIf([type]=5,"Query","Table") AS qt
   '           FROM MSysObjects AS mso
   '           WHERE ((mso.Type = 5 Or mso.Type = 1) And (mso.Flags = 0))
   '           ORDER BY mso.Name;
   ' ColumnCount --> 4
   ' ColumnWidths --> 3";1.5";1.5";1"
   ' ListWidth --> 7.2"
' ========================================================================
'
' the only object needed to use the Random Picker example is this form
'   a random record will be chosen from the records that are displayed
'   after a data source is chosen.
'
' the records can be filtered before choosing a winner
' NOTE: because you CAN filter the form before choosing a record,
'       you can first eliminate records that you do not want to consider.
'
' If the records are filtered after choosing a table or query,
'   the number of contestants will be reported when the winner is chosen
'
' ======================================================================== 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ cbo_PickData_AfterUpdate 
Private Sub cbo_PickData_AfterUpdate()
'110413, 110602 added comments

   'set up error handler  

   On Error GoTo Proc_Err
   
   'if not data set is chosen, then exit  
   If IsNull(Me.cbo_PickData) Then Exit Sub
   
   'dimension variables  
   Dim sStr As String _
      , nNumRecs As Long
   
   'cbo_PickData.Columns
   ' 0 = Name
   ' 1 = DateCreate
   ' 2 = DateUpdate
   ' 3 = Type --> "Table" or "Query"
   
   'make a string with --> Type : NameOfTableOrQuery     
   sStr = Me.cbo_PickData.Column(3) & "." & Me.cbo_PickData
   
   'set the subform to hold the table or query the user chose  

   Me.f_subform.SourceObject = sStr

   'get number of records in the chosen data set     
   nNumRecs = GetNumberOfRecords()
   
   'change the Datasheet view caption 
   Me.Label_Contestants.Caption = Format(nNumRecs, "#,##0") & " Contestants"
   
   If nNumRecs > 0 Then
      'enable the command button to pick a winner  
      Me.cmdPickWinner.Enabled = True
   Else
      'no records to pick from 
      Me.cmdPickWinner.Enabled = False
   End If
   

'exit code     
Proc_Exit:
   On Error Resume Next
   Exit Sub
  
'error handler    
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   cbo_PickData_AfterUpdate " & Me.Name

   Resume Proc_Exit
   Resume
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GetNumberOfRecords 
Private Function GetNumberOfRecords() As Long
'110413, 110602

   'RETURN the number of records in the subform 

   'set up error handler     
   On Error GoTo Proc_Err
   
   'initialize return value to be zero     
   GetNumberOfRecords = 0
   
   'use the data that was chosen 

   With Me.f_subform.Form.RecordsetClone
 
      'if there are no records, then exit 
      If .EOF Then GoTo Proc_Exit
	  
      'move to the last record  
      .MoveLast
	  
      'return the number of records  	  
      GetNumberOfRecords = .RecordCount
	  
   End With
   
'comment or delete next statement if you wish     

Debug.Print "GetNumberOfRecords: " & GetNumberOfRecords

'exit code 
Proc_Exit:
   On Error Resume Next
   Exit Function

 'error handler  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   GetNumberOfRecords " & Me.Name

   Resume Proc_Exit
   Resume
End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ cbo_PickData_MouseUp 
Private Sub cbo_PickData_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'110414, 110602
   'drop combobox when user releases mouse button inside control  
   'ignore error if there is one  
   On Error Resume Next
   
   'drop combobox when user releases mouse button inside control 

   Me.ActiveControl.Dropdown
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ cmd_Close_Click 
Private Sub cmd_Close_Click()
'110414, 110602
   'ignore error if there is one  
   On Error Resume Next
   
   'close the form without saving changes 
   DoCmd.Close acForm, Me.Name, acSaveNo
   
      'alternately: close the form and save changes
      '             DoCmd.Close acForm, Me.Name, acSaveYes  
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ cmdPickWinner_Click 

Private Sub cmdPickWinner_Click()
'110414, 110602
' HIGHLIGHT A RANDOM RECORD in the chosen data set
' the random number function returns a number  >=0 and <1  
'
'   Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
'
' written by Crystal as an example for
' http://www.youtube.com/watch?v=ToSv1v1FY5A
'
' 
   'set up error handler 
   On Error GoTo Proc_Err
   
    'dimension variables 
   Dim nNumRecs As Long _
      , nWinner As Long _
      , sControlName As String _
      , strValue As String _
      , iCol As Integer
      
   'dimension object variables 
   Dim c As Control _
      , fDataSet As Form
   
   'make sure subform has a source object 

   If Me.f_subform.SourceObject = "" Then
      Me.cbo_PickData.SetFocus
      MsgBox "Select Data first", , "choose contestants"
      Me.cbo_PickData.Dropdown
      Exit Sub
   End If
   
   'get the number of records  
   nNumRecs = GetNumberOfRecords()
   
   'if there are no records, then give the user a message and exit
   '   if the command button is disabled with no records,
   '   then this code would not get executed ... but just in case...     
   If nNumRecs = 0 Then
      MsgBox "Pick Data to find a winner in", , "Cannot find random record"
      GoTo Proc_Exit
   End If
   
' if you want to pick more than one random record, or see what was chosen,
' look in Immediate (debuG) Window for results, CTRL-G     
Debug.Print "--------------------- New contest --------------------- " & Now()

   'update the form with the number of contestants
   '   (in case user has filtered list since picking data source) 
   Me.Label_Contestants.Caption = Format(nNumRecs, "#,##0") & " Contestants"
   
   'set the seed for the random number function 

   Randomize (Timer * 10)
   
   ' Pick a winning number! 
   '   (Rnd could return zero so add 1)
   nWinner = Int(nNumRecs * Rnd) + 1
   
   'set the focus on the data set  
   Me.f_subform.SetFocus
   
   'set an object variable for the table or query inside the subform  
   Set fDataSet = Me.f_subform.Form
   
   'use the data set displayed on the form  
   With fDataSet
   
      'move to the first record  

      .Recordset.MoveFirst

      'move to the random record that was chosen  
      .Recordset.Move (nWinner - 1)
	  
      'set the focus on the first field that is not hidden 
      iCol = 0
	  
	  'loop through the controls until there is one not hidden: should be first column in data set  
      For Each c In .Controls
         With c
		    'if the column is not hidden then get information  

            If .ColumnHidden = False Then
			
               'get the name of the field  
               sControlName = .Name
			   
               'set the focus to the first control (field) (column displayed)  
               fDataSet.Controls(.Name).SetFocus
			   
   'comment or remove next statement if you want  			   
   Debug.Print fDataSet.Name & ": setfocus to --> " & .Name & Space(5) & "= " & strValue
   
               ''echo the values in the first 2 fields to the user --> FieldValue1 (FieldValue2)
               'build a string to use in the message box  

               If iCol = 0 Then
                  'this is the first field displayed for the record  
                  strValue = .Value
                  iCol = iCol + 1
               Else
                  'this is the second field displayed for the record 
                  strValue = strValue & " (" & .Value & ")"
                  Exit For
               End If
            End If
         End With 'c
      Next c
   End With 'fDataSet 
   
   'select the record  

   DoCmd.RunCommand acCmdSelectRecord
   
   'give the user a message  
   MsgBox "Winner is record " & nWinner _
      & vbCrLf & "out of " & Format(nNumRecs, "#,##0") & " contestants" _
      & vbCrLf & vbCrLf & Space(15) & "Congratulations! " & strValue _
      , , "... (drum roll)... The winner is ... !"
	  
'comment or remove next statement if you want  	  

Debug.Print "Winner is record " & nWinner & " out of " & Format(nNumRecs, "#,##0") & " contestants"
      
'exit code     
Proc_Exit:
   On Error Resume Next
   Set c = Nothing
   Set fDataSet = Nothing
   Exit Sub
  
'Error handler 
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   cmdPickWinner_Click : " & Me.Name

   Resume Proc_Exit
   Resume
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Form_Open 
Private Sub Form_Open(Cancel As Integer)

''110413, 110602
   'ignore error if there is one 
   On Error Resume Next
   
   'when the form opens:
   
   '1. clear the data set   
   Me.f_subform.SourceObject = ""
   
   '2. reset the caption for the number of contestants  
   Me.Label_Contestants.Caption = "Contestants"
   
   '3. disable the command button to pick a winner  
   Me.cmdPickWinner.Enabled = False
   
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Label_footer_Click 

Private Sub Label_footer_Click()
''110414, 110602
   'ignore error if there is one
   On Error Resume Next
   
    'start email to Crystal using the default email carrier  
   Application.FollowHyperlink _
      "mailto: strive4peace2010@yahoo.com?subject=Random Picker comment"
End Sub
	
Go To Top           Quick Jump


If you have a comment or want to tell me how you like my Random Picker, thank you —
leave your comment on a thread I am currently posting to about it
OR email me.



Free Book on Access: Access Basics

Free Tutorials: Video Tutorials

for information on private programming and training, or if you have comments and ideas, I'd love to hear from you


Copyright © 2011-2016 Crystal Long | All rights resorved | Last updated Nov 2016 |