[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

How to generate numbers in a certain range?

Posted on 2011-10-06
9
Medium Priority
?
245 Views
Last Modified: 2013-01-26
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
0
Comment
Question by:Thomas_Meyer
  • 5
  • 3
9 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36929264
In re not repeating ... is that ever or just for the time that the document is open?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36929416
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36929836
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 36929842
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
 
LVL 46

Expert Comment

by:aikimark
ID: 36930285
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
 

Author Closing Comment

by:Thomas_Meyer
ID: 36932063
Perfect! Thank you very much for your help, the function works flawlessly.
Best regards,
TM
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 36932241
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
 
LVL 46

Expert Comment

by:aikimark
ID: 36933355
@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
 
LVL 46

Expert Comment

by:aikimark
ID: 38822759
I've republished the VB PRNG article on EE:
http:A_11114.html
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…

834 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question