VBA – Generate a Random Date Between Two Dates

Reworking an old demo database, I came across some code to generate a random date between two supplied dates and thought it could be of use to other.

 

'---------------------------------------------------------------------------------------
' Procedure : GetRndDate
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Get a random date between 2 dates
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' dtStartDate : Minimum Date value
' dtEndDate   : Maximum Date value
'
' Usage:
' ~~~~~~
' dtRnd = GetRndDate(#12/01/2002#, #01/05/2015#)
'           Will return a random date between #12/01/2002# and #01/05/2015#
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-02-07              Initial Release
' 2         2017-02-09              Added check that Start is < to End
'                                   Added Comments to code
' 3         2018-09-20              Updated Copyright
'---------------------------------------------------------------------------------------
Function GetRndDate(dtStartDate As Date, dtEndDate As Date) As Date
    On Error GoTo Error_Handler
    Dim dtTmp                 As Date

    'Swap the dates if dtStartDate is after dtEndDate
    If dtStartDate > dtEndDate Then
        dtTmp = dtStartDate
        dtStartDate = dtEndDate
        dtEndDate = dtTmp
    End If
    
    Randomize
    GetRndDate = DateAdd("d", Int((DateDiff("d", dtStartDate, dtEndDate) + 1) * Rnd), dtStartDate)

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GetRndDate" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

One response on “VBA – Generate a Random Date Between Two Dates