Private Sub GeometricRandomTest()
    ' Test the GeometricRandom function.

    Const lngTrials = 25
    Const lngTries = 100000

    Dim alngRes(0 To lngTrials) As Long

    Dim lngCur As Long
    For lngCur = 1 To lngTries
        Dim lngTmp As Long
        lngTmp = GeometricRandom(0.5)
        If lngTmp > UBound(alngRes) Then lngTmp = UBound(alngRes)
        alngRes(lngTmp) = alngRes(lngTmp) + 1&
        If lngCur Mod 10000& = 0& Then Debug.Print Now & " " & lngCur
    Next lngCur

    For lngCur = 0 To lngTrials
        If alngRes(lngCur) <> 0 Then
            Debug.Print lngCur, alngRes(lngCur)
        End If
    Next lngCur
End Sub