MS Access – VBA – Retrieve a Random Record

Another interesting question I was once asked on an Access forum was how can one retrieve a random record in a form?

I was actually perplexed as to how to approach this request, but it really isn’t that complicated at the end of the day. The code below demonstrates one possible method.

'---------------------------------------------------------------------------------------
' Procedure : GetRndRec
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Goto/retrieve a random record
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Dec-21             Initial Release
'---------------------------------------------------------------------------------------
Function GetRndRec()
On Error GoTo Error_Handler
    Dim db          As DAO.Database
    Dim rs          As DAO.Recordset
    Dim tblName     As String   'Table to pull random record from
    Dim iRecCount   As Long     'Number of record in the table
    Dim iRndRecNum  As Integer
    
    tblName = "YourTableName"
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(tblName, dbOpenSnapshot, dbReadOnly, dbReadOnly)
    
    If rs.RecordCount <> 0 Then 'ensure there are records in the table before proceeding
        With rs
            rs.MoveLast   'move to the end to ensure accurate recordcount value
            iRecCount = rs.RecordCount
            iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1) 'Get Random Rec Number to use
            rs.MoveFirst
            .Move CLng(iRndRecNum)
            GetRndRec = ![YourFieldName]
        End With
    End If

Resume Error_Handler_Exit
    On Error Resume Next
    'Cleanup
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetRndRec" & vbCrLf & _
           "Error Description: " & Err.Description _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function