Random generator not repeating numbers. How to stop it?

If you have a limited number of integers, then use a boolean array

Dim AlreadyDrawn(1000) as boolean

Do
     NewNumber = MyGetRandomNumberFunctionUpTo1000()
While AlreadyDrawn(NewNumber)

AlreadyDrawn(NewNumber) = True

Hi,

PS. Your subject may be misleading: "Random generator not repeating numbers. How to stop it?"

Do you actually mean "Random generator repeating numbers. How to stop it?" ?

How about something using the Dictionary object; like this?...

' Start of Code...

Option Explicit
Public Sub Select_Unrepeated_Random_Numbers(ByRef lngArray() As Long, _
                                            Optional ByVal lngMinimum As Long = 0&, _
                                            Optional ByVal lngMaximum As Long = 0&)

' ----------------------------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Programming \ Languages \ Visual Basic
' https://www.experts-exchange.com/questions/21743518/Random-generator-not-repeating-numbers-How-to-stop-it.html
' Random generator not repeating numbers. How to stop it?
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 20 February 2006
' ----------------------------------------------------------------------------------------------

  Dim blnWend                                           As Boolean
  Dim lngLoop                                           As Long
  Dim lngIndex                                          As Long
  Dim lngValue                                          As Long
  Dim objDictionary                                     As Object
  Dim vntKeys                                           As Variant
 
  On Error Resume Next
 
  If lngMinimum = 0& And lngMaximum = 0& Then
     lngMinimum = LBound(lngArray)
     lngMaximum = UBound(lngArray)
  End If
 
  If lngMaximum - lngMinimum < UBound(lngArray) - LBound(lngArray) Then
     Exit Sub
  End If
 
  Erase lngArray()
 
  Set objDictionary = CreateObject("Scripting.Dictionary")
 
  Randomize
 
  While Not (blnWend)
 
     DoEvents
     
     lngValue = CLng(Int(Rnd() * (lngMaximum + 1& - lngMinimum))) + lngMinimum
   
     If Not (objDictionary.Exists(lngValue)) Then
        objDictionary.Add lngValue, objDictionary.Count + 1&
        blnWend = (objDictionary.Count = UBound(lngArray) + 1& - LBound(lngArray))
     End If
     
  Wend
 
  vntKeys = objDictionary.Keys
 
  lngIndex = -1&
 
  For lngLoop = LBound(lngArray) To UBound(lngArray)
      lngIndex = lngIndex + 1&
      lngArray(lngLoop) = vntKeys(lngIndex)
  Next lngLoop
 
  Set objDictionary = Nothing
 
End Sub
Public Sub Test()

  Dim lngArray(49)                                      As Long ' 50 Numbers
  Dim lngLoop                                           As Long
 
  Call Select_Unrepeated_Random_Numbers(lngArray, 1&, 50&)      ' Numbers 1..50
 
  ' Cells.ClearContents
 
  For lngLoop = LBound(lngArray) To UBound(lngArray)
      ' Cells(lngLoop + 1&, 1) = lngArray(lngLoop)
      Debug.Print lngArray(lngLoop)
  Next lngLoop
 
End Sub

' ...End of Code


BFN,

fp.

fanpages thanks for help but your example is to complex and the best solutions are simple ones. Yes youre right, my topic title is wrong, but I don't know how to edit and correct it.

grahamskan:
your idea is very good I think, but as I see your code is wrong. This is what I want it to do (algorithm):

Do While any of booleans are false {AlreadyDrawn(1)=false or AlreadyDrawn(2)=false...3...4...}
                                                                I
                                                                I
                                                                V
                                                 Generate Random Number
                                                                I
                                                                I
                                                                V
                                           Check if Random number is drawn
                                                                I
                                                                I
                                                                V
If rnd is not drawn then write it to textbox and assign true value to his boolean (If rnd=2 then assign this: AlreadyDrawn(2)=true)
                                                                I
                                                                I
                                                                V
                                                    Loop (repeat all above)
                                                                I
                                                                I
                                                                V
    If rnd is drawn then go back to generating random number (generate another random number)                                                  



Thats it. After that loop above I just need to assign false value to all booleans (AlreadyDrawn(**whole array**)=false)

Thats another problem, how to assign boolean value to whole array at once? Something like this but this isnt working: AlreadyDrawn(1,2,3,4) = False  ???

Ah I found the solution by myself, but thanks anyways. This is the real solution:

Dim AlreadyDrawn(4) As Boolean
Dim NewNumber As Integer
Dim NewNumberStr As String


Private Sub Command1_Click()

Do While AlreadyDrawn(1) = False Or AlreadyDrawn(2) = False Or AlreadyDrawn(3) = False Or AlreadyDrawn(4) = False

10: NewNumber = (3 - 1 + 1) * Rnd + 1
     NewNumberStr = NewNumber
     
If AlreadyDrawn(NewNumber) = False Then
     Text1.Text = Text1.Text + NewNumberStr
     AlreadyDrawn(NewNumber) = True
Else
    GoTo 10
End If
Loop

AlreadyDrawn(1) = False
AlreadyDrawn(2) = False
AlreadyDrawn(3) = False
AlreadyDrawn(4) = False

End Sub

Private Sub Form_Load()
Randomize
End Sub




But can you please answer to my question: How can I assign boolean value to whole array at once?

My code was only intended to ensure that each random number generated is unique.

Are you saying that you want a list of all possible numbers in the range in a random order?

Sub CreateRandomList()
    Const MaxRandom = 100
    Dim bAlreadyDrawn() As Boolean
    Dim iDrawnCount As Integer
    Dim r As Integer
   
    ReDim bAlreadyDrawn(100)
    iDrawnCount = 0
    Do Until iDrawnCount = MaxRandom
        Do
            r = Int(Rnd * MaxRandom) + 1
        Loop While bAlreadyDrawn(r)
        Text1.Text = Text1.Text & vbCrLf & r
        bAlreadyDrawn(r) = True
        iDrawnCount = iDrawnCount + 1
    Loop
End Sub

Sorry. I didn't refresh.

This line resets the boolean array to all false
  ReDim bAlreadyDrawn(100)
 

Incidentally, I think this code line of yours could get a bit unwieldyif the number of choices increases:

Do While AlreadyDrawn(1) = False Or AlreadyDrawn(2) = False Or AlreadyDrawn(3) = False Or AlreadyDrawn(4) = False

I want to declare whole array as true or as false at once.
I want to get this line shorter:
Do While AlreadyDrawn(1) = False Or AlreadyDrawn(2) = False Or AlreadyDrawn(3) = False Or AlreadyDrawn(4) = False

When you declare a Boolean array, all the elements are automatically set to false. You cannot Dim as all True.

if i change this:
AlreadyDrawn(1) = False
AlreadyDrawn(2) = False
AlreadyDrawn(3) = False
AlreadyDrawn(4) = False

to this

ReDim AlreadyDrawn(4)


I get an error: Array already dimensioned

I just want to be able to set all booleans to true or to false whenever I need to, so I can restart the process.

I need to get rid of this line:
Do While AlreadyDrawn(1) = False Or AlreadyDrawn(2) = False Or AlreadyDrawn(3) = False Or AlreadyDrawn(4) = False
 
and to replace it with something which could do the same thing, but it must be editable, because I will change number of booleans to max of 32. (minimum is 4)

And second thing I need to get rid of is:
AlreadyDrawn(1) = False
AlreadyDrawn(2) = False
AlreadyDrawn(3) = False
AlreadyDrawn(4) = False

I also need to replace it with something but i know how:

for i=1 to x
AlreadyDrawn(i)=false
next i

where x is number of those booleans. How to fix that problem above?

If you look at my code (6.05 PM GMT), you will see that I keep a count (iDrawnCount) and test that to find when the whole job is done, instead of checking each array element.

You don't need to reset the Boolean array to all false. If you do you will lose track of which numbers are already drawn. You would only need to do that if you wanted to do another complete draw.

If you did want to ReDim, the array must first be declared unsized:

    Dim bAlreadyDrawn() As Boolean

" fanpages thanks for help but your example is to complex and the best solutions are simple ones... "

It may only seem complex if you do not understand what it is doing.

Would you like me to explain, or are you going to progress other solutions (first)?

BFN,

fp.

I'm still trying to implement GrahamSkans code into my project. His code works fine, but I want it to work for me now.

I didn't say that your code is bad or not working, I didn't read it or even tried to because yes, its to complex. I mean that because its to long for this simple function. It's like you write 100 lines of code for, I don't know, calculating some math formula and printing it in textbox or messaging it. Just saying that its too long for this simple problem (which I couldn't crack, or I could but not without loosing to much time), thats it.

How to pause a code execution for some period (lets say 1 second)? I used your code in my app and its working perfectly, thanks GrahamSkan, but I dont want it to draw all numbers almost instantly. I want it to draw one number then wait for some period of time (1 second) and draw another number. I dont want to use timer because it's not good with it. Is there some simple method for pausing a code? I tried with do...loop and for...next loops but its not good (even with counting to large numbers).

It's not clear why you don't want to use the Timer control, but you could use the Sleep API Instead.

Option Explicit
Private Declare Sub Sleep Lib "kernel32" ( ByVal dwMilliseconds As Long)


Sub CreateRandomList()
    Const MaxRandom = 100
    Dim iDrawnCount As Integer
    Dim r As Integer
    Dim bAlreadyDrawn() As Boolean
    ReDim bAlreadyDrawn(100)
    iDrawnCount = 0
    Do Until iDrawnCount = MaxRandom
        Sleep 1000
        Do
            r = Int(Rnd * MaxRandom) + 1
        Loop While bAlreadyDrawn(r)
        Debug.Print r
        Text1.Text = Text1.Text & vbCrLf & r
        bAlreadyDrawn(r) = True
        iDrawnCount = iDrawnCount + 1
        DoEvents
    Loop
End Sub

I dont understand why its not working in "real time". When I run the app to the cursor(Ctrl+F8) and run the code step by step (F8) then sleep is working properly and every time after number is generated i got to wait for a second before loop reruns, so everything is ok. But when i run the code normaly (F5) then its not working normaly. When the execution comes to the point when it should sleep it doesnt wait for a second, it waits for 4 or 5 seconds and draws all numbers at once. So my app first waits for 4-5 secs before draw and then draws all numbers at once, but on Ctrl+F8 its working normaly. Same thing is happening when i'm using do...loop or for...next loops. Why?!?

This article shows another way of how to do it.  It is Excel-oriented, but can be adapted for "pure" VB
applications if you are interested.

http://vbaexpress.com/kb/getarticle.php?kb_id=760

BTW, re: your reluctance to even test Nigel's (aka fanpages) code puzzles me.  Just because something
looks long does not necessarily mean it is complicated.  Nigel's accumulated over 1 million points here
because he is a very, very talented programmer.

Patrick

Incidentally, Patrick is right about fanpages, though he failed to mention that he is no mean programmer himself, having accumulated more points than either of us.

Great thanks for all your help GrahamSkan. Now its fully functional. Thank you again.

And matthewspatrick I didn't mean anything bad about fanpages, nor I thought he is bad programmer. I just don't like long code for simple things. I didn't look into his code because from the beginning when I first saw it I knew I wont use it because its too long, as I said before. I didn't mean it is bad or not working or anything else.

Removing the blank lines (added for readabilty), my comment header, and all the various error handling & range checking I placed to make the code more robust, I don't think there's that much between what you are using & what the line count of compressed code would be.

FYI: I use DoEvents to ensure that your system does not grind to a halt, also.  You may like to consider something similar.


But it's your decision in the long-run.  It's just a shame you didn't try my suggestion on principle as you could've had a working solution more than 2 days ago.

Thanks for trying to make convincing arguments everybody else.

BFN,

fp.

i checked your code fp. dunno what to say, its to complex....for me. I never worked with dictionary objects so I dont understand some parts of it. But no matter, its already working.
Anyways, are you programming in other languages too? Cause, vb kind off...sucks. But for newbies like me its good, very good for creating simple apps, and fast, drag&drop&code. But for more serious progs it really sucks.

vbr666,

Perhaps instead of just throwing up your hands and saying "it's too complex", why not ask for an explanation
of what the code is doing?  That way, you might just learn something.  And if you never even bothered to test
Nigel's code, how do you know that it wasn't the right solution?

OK, lecture over.  I suspect that Nigel used a Dictionary object (go to www.msdn.com if you want to learn more
about it) because it stores stuff using unique keys.  So, it looks like Nigel was generating random numbers and
attempting to add them as keys to the Dictionary object; if that number hadn't been added before, then the
operation succeeds.  If it has been added before, the operation fails (and that is why Nigel put in On Error
Resume Next--to ignore the error and keep plowing on).  It looks to me that the While...Wend is there to check
and see if we have enough unique numbers.

I am told that the Dictionary object is kind of similar to Perl's associative array; never having done Perl I cannot
vouch for that.

Patrick