How to generate numbers in a certain range?

Hi,
 help me with a macro that will generate random values¿¿? I need to get my macro when pressing "random-number" generated the numbers in the range from 200 to 45000000 But with the rule that generated numbers should not be repeated. The result should be displayed as "Shape1" the text with a colon (I attach my .ppt file).
Thank you in advance for all your help,
TM test-random-number.ppt
Thomas_MeyerAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
Apologies the wrong code was pasted by me ...

Chris
Function getnum2() As Long
Dim lngLow As Long
Dim lngHigh As Long
Dim lngNum As Long
Static dict As Object
Dim fso As Object
Dim readFile As Object
Dim strFileText As String
Dim arr As Variant
Dim itm As Variant
Const strFileName As String = "c:\deleteme\somefile4.txt"

    
    Randomize Now()
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FileExists(strFileName) Then
        fso.createTextFile strFileName, False
    End If
    If dict Is Nothing Then
        Set dict = CreateObject("scripting.dictionary")
        Set readFile = fso.OpenTextFile(strFileName, 1, False)
        If readFile.atendofstream Then
            readFile.Close
        Else
            strFileText = readFile.ReadAll
            readFile.Close
            arr = Split(strFileText, vbCrLf)
            For Each itm In arr
                If itm <> "" Then dict.Add itm, itm
            Next
        End If
    End If
    lngLow = 200
    lngHigh = 45000000
    lngNum = CLng((lngHigh - lngLow + 1) * Rnd() + lngLow)
    Do While dict.exists(lngNum)
        lngNum = CLng((lngHigh - lngLow + 1) * Rnd() + lngLow)
    Loop
    dict.Add lngNum, lngNum
    Set readFile = fso.OpenTextFile(strFileName, 8, False)
    readFile.WriteLine (lngNum)
    readFile.Close
    getnum2 = lngNum

End Function

Open in new window

0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
In re not repeating ... is that ever or just for the time that the document is open?
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
For example assuming it is valid for as long as the application is open then a call to getnum the source for which should be in a normal code module)  will return a unique number within the range.

For example
msgbox(getnum)
or
myvar = getnum

Chris
Function getnum() As Long
Dim lngLow As Long
Dim lngHigh As Long
Dim lngNum As long
Static dict As Object

    If dict Is Nothing Then Set dict = CreateObject("scripting.dictionary")
    lngLow = 200
    lngHigh = 45000000
    lngNum = CDbl((lngHigh - lngLow + 1) * Rnd() + lngLow)
    Do While dict.exists(lngNum)
        lngNum = CLng((lngHigh - lngLow + 1) * Rnd() + lngLow)
    Loop
    dict.Add lngNum, lngNum
    getnum = lngNum

End Function

Open in new window

0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

 
Chris BottomleySoftware Quality Lead EngineerCommented:
Assuming you want to memorise the total usage then this will require a file copy of data ... which the following will give you.

Modify the line;
Const strFileName As String = "c:\deleteme\somefile3.txt"

for a file path and name of your choice.

Chris
Function getnum2() As Long
Dim lngLow As Long
Dim lngHigh As Long
Dim lngNum As Long
Static dict As Object
Dim fso As Object
Dim readFile As Object
Dim strFileText As String
Dim arr As Variant
Dim itm As Variant
Const strFileName As String = "c:\deleteme\somefile3.txt"

    
    Randomize Now()
    Set fso = CreateObject("Scripting.FileSystemObject")
    If dict Is Nothing Then
        Set dict = CreateObject("scripting.dictionary")
        If Not fso.FileExists(strFileName) Then
            fso.createTextFile strFileName, False
        End If
        Set readFile = fso.OpenTextFile(strFileName, 1, False)
'        Else
'            fso.CreateTextFile "strFileName, True
'            Set readFile = fso.OpenTextFile(strFileName, False)
'        End If
        If readFile.atendofstream Then
            readFile.Close
        Else
            strFileText = readFile.ReadAll
            readFile.Close
            arr = Split(strFileText, vbCrLf)
            For Each itm In arr
                If itm <> "" Then dict.Add itm, itm
            Next
        End If
    End If
    lngLow = 200
    lngHigh = 45000000
    lngNum = CLng((lngHigh - lngLow + 1) * Rnd() + lngLow)
    Do While dict.exists(lngNum)
        lngNum = CLng((lngHigh - lngLow + 1) * Rnd() + lngLow)
    Loop
    dict.Add lngNum, lngNum
    Set readFile = fso.OpenTextFile(strFileName, 8, False)
    readFile.WriteLine (lngNum)
    readFile.Close
    getnum2 = lngNum

End Function

Open in new window

0
 
aikimarkCommented:
Chris

This article might be helpful.
http://www.15seconds.com/issue/051110.htm

There are limitations in the Randomize function as well as the Rand function.  Since this problem requires an upper limit of 45M, we can't just iterate through the series.  :-(
0
 
Thomas_MeyerAuthor Commented:
Perfect! Thank you very much for your help, the function works flawlessly.
Best regards,
TM
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
aikimark

I may have missed your point but the link you posted expands on the pseudo random nature of RAND.  If I have missed the point then it simply exemplifies why as experts we should post detailed responses instead of a reference to another site without explanation.

If however the repeatability of the RNG is your point then I direct you to look at the actual solution which uses a dictionary to enforce uniqueness.

TM

Glad to help.

Chris
0
 
aikimarkCommented:
@Chris

My comment and article reference was primarily directed at future readers and, possibly, Thomas_Meyer.  Most developers do not understand PRNGs and think that the numbers generated are truly random.  Regardless of their (post generated) uniqueness, there may be other 'randomness' requirements that weren't discussed in this thread prior to closure.

Since we never saw a response to your context questions prior to closure, some of my concerns about the VB PRNG use (vs. expectations) and performance issues are unknown.
0
 
aikimarkCommented:
I've republished the VB PRNG article on EE:
http:A_11114.html
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.