[AccessD] Create a random date/time

[Gustav Brock]

Hi Bill

You are correct. The reason is - as Stuart mentions - rounding or rather missing rounding.

It's a good example of when you think you are smart you may be too smart. So I have expanded and modified my smart function to take care of the flaw. While at it, I've added the option to include or not the date, time, or millisecond part in the output:

<code>
Public Function DateRandom( _
    Optional ByVal UpperDate As Date = #12/31/9999#, _
    Optional ByVal LowerDate As Date = #1/1/100#, _
    Optional ByVal DatePart As Boolean = True, _
    Optional ByVal TimePart As Boolean = True, _
    Optional ByVal MilliSecondPart As Boolean = False) _
    As Date
    
'   Generates a random date/time - optionally within the range of LowerDate and/or UpperDate.
'   Optionally, return value can be set to include date and/or time and/or milliseconds.
'
'   2015-08-28. Gustav Brock, Cactus Data ApS, CPH.
'   2015-08-29. Modified for uniform distribution as suggested by Stuart McLachlan by
'               combining a random date and a random time.
'   2015-08-30  Modified to return selectable and rounded value parts for
'               Date, Time, and Milliseconds.
    
    Const SecondsPerDay As Long = 60& * 60& * 24&
    
    Dim DateValue   As Date
    Dim TimeValue   As Date
    Dim MSecValue   As Date
    
    ' If all parts are deselected, select date and time.
    If Not DatePart And Not TimePart And Not MilliSecondPart = True Then
        DatePart = True
        TimePart = True
    End If
    If DatePart = True Then
        ' Remove time parts from UpperDate and LowerDate as well from the result value.
        ' Add 1 to include LowerDate as a possible return value.
        DateValue = CDate(Int((Int(UpperDate) - Int(LowerDate) + 1) * Rnd) + Int(LowerDate))
    End If
    If TimePart = True Then
        ' Calculate a time value rounded to the second.
        TimeValue = CDate(Int(SecondsPerDay * Rnd) / SecondsPerDay)
    End If
    If MilliSecondPart = True Then
        ' Calculate a millisecond value rounded to the millisecond.
        MSecValue = CDate(Int(1000 * Rnd) / 1000 / SecondsPerDay)
    End If
    
    DateRandom = DateValue + TimeValue + MSecValue

End Function
</code>

Note that Access will - for display - round milliseconds to the nearest second. That means that for example 23.59:59.777 rounds to 00:00:00 of the following day, thus you had a minimum and maximum date with a difference of one day.

Adjusting your test function to use the modified DateRandom:

<code>
Sub testformula()
Dim dt As Date
Dim i As Long
Dim dttemp As Date
dt = Date
Dim dtMax As Date
Dim dtMin As Date
dtMin = CDate("1/1/2100")
dtMax = CDate("1/1/1900")
For i = 1 To 1000000#
     dttemp = DateRandom(dt, dt, , False)
     If dttemp > dtMax Then dtMax = dttemp
     If dttemp < dtMin Then dtMin = dttemp
 Next
Debug.Print dtMin, dtMax
End Sub
</code>

it now returns:

2015-08-30    2015-08-30

and if TimePart is True:

2015-08-30    2015-08-30 23:59:59

/gustav

________________________________________
Fra: AccessD <accessd-bounces at databaseadvisors.com> på vegne af Bill Benson <bensonforums at gmail.com>
Sendt: 29. august 2015 20:55
Til: Access Developers discussion and problem solving
Emne: Re: [AccessD] Create a random date/time

There is a flaw in that function. Consider this for the current date

Sub testformula()
Dim dt As Date
Dim i As Long
Dim dttemp As Date
dt = Date
Dim dtMax As Date
Dim dtMin As Date
dtMin = CDate("1/1/2100")
dtMax = CDate("1/1/1900")
For i = 1 To 1000000#
    dttemp = CDate((CLng(dt) - CLng(dt)) * Rnd + CLng(dt) + Rnd)
    If dttemp > dtMax Then dtMax = dttemp
    If dttemp < dtMin Then dtMin = dttemp
Next
Debug.Print dtMin, dtMax
End Sub

I got an answer of

8/29/2015     8/30/2015


On Sat, Aug 29, 2015 at 2:10 PM, Gustav Brock <gustav at cactus.dk> wrote:

> Hi Stuart
>
> Thanks for the link - you are absolutely right - why didn't I think about
> this?
> While I believe - for the purpose - one could live with this limitation,
> the modification needed is really really simple:
>
> Initial method:
>
>     RandomDate = CDate((CLng(UpperDate) - CLng(LowerDate)) * Rnd * Rnd +
> CLng(LowerDate))
>
> Modified as to your suggestion:
>
>     RandomDate = CDate((CLng(UpperDate) - CLng(LowerDate)) * Rnd + Rnd +
> CLng(LowerDate))
>
> This is possible because Rnd returns values >= 0 and < 1, exactly matching
> the numeric value range of Time.
>
> The corrected function:
>
> <code>
> Public Function DateRandom( _
>     Optional ByVal UpperDate As Date = #12/31/9999#, _
>     Optional ByVal LowerDate As Date = #1/1/100#) _
>     As Date
>
> '   Generates a random date/time - optionally within the range of
> LowerDate and/or UpperDate.
> '
> '   2015-08-28. Gustav Brock, Cactus Data ApS, CPH.
> '   2015-08-29. Modified for uniform distribution as suggested by Stuart
> McLachlan by
> '               combining a random date and a random time.
>
>     Dim RandomDate  As Date
>
>     ' Random date: (CLng(UpperDate) - CLng(LowerDate)) * Rnd +
> CLng(LowerDate)
>     ' Random time: Rnd
>     RandomDate = CDate((CLng(UpperDate) - CLng(LowerDate)) * Rnd +
> CLng(LowerDate) + Rnd)
>
>     DateRandom = RandomDate
>
> End Function
> </code>
>
> /gustav