Random Numbers Greater Than 65,000

[Paul Black]

Hi Everyone,

Tom Ogilvy Posted the Following Code in 2001 for Generating Random
Numbers :-

Sub Sets()
Application.ScreenUpdating = False
Dim my(1 To 49)

For j = 1 To 10
' Reinitialize Array Before Selecting.
For I = 1 To 49
my(I) = I
Next I

For k = 1 To 6
Randomize
NewNumber:
Number = Int(49 * Rnd) + 1
If my(Number) = "" Then
GoTo NewNumber
Else
Cells(j, k) = my(Number)
my(Number) = ""
End If
Next k
Next j
Application.ScreenUpdating = True
End Sub

This Works Excellent and Does NOT give a Repeated Number ( 1 to 49 )
in Any Set of Six Numbers.
I would like to be able to Produce a Random Number List of 200,000
Sets of Six Numbers.
How can the Above Code be Modified so that when it Reaches 65,000 Sets
of Six Numbers it Moves Nine Columns to the Right and goes Back to Row
One. I know it needs something like :-

ActiveCell.Offset(-65000, 9).Select

I do NOT know where this should be Entered into the Above Code OR the
Extra Coding that is Needed in Order for this to Work.
Any Help will be Appreciated.

All the Best
Paul

 

[Bernie Deitrick]

Paul,

How about 4 nice blocks of 50,000 rows each? The code will take a little
while to run....

Sub Sets2()
Application.ScreenUpdating = False
Dim my(1 To 49)
Dim j As Long

For j = 0 To 199999
' Reinitialize Array Before Selecting.
For I = 1 To 49
my(I) = I
Next I

For k = 1 To 6
Randomize
NewNumber:
Number = Int(49 * Rnd) + 1
If my(Number) = "" Then
GoTo NewNumber
Else
Cells(j Mod 50000 + 1, k + 9 * (j \ 50000)) = my(Number)
my(Number) = ""
End If
Next k
Next j
Application.ScreenUpdating = True
End Sub

 

[keepITcool]

Bernie..

This would make it execute a 'little' bit faster.

Sub Sets2()
Dim tmp&(1 To 49), arr&(1 To 50000, 1 To 24)
Dim i&, j&, k&, n&

For j = 0 To 199999
'Reinitialize Array Before Selecting.
For i = 1 To 49
tmp(i) = i
Next i
For k = 1 To 6
Randomize
NewNumber:
n = Int(49 * Rnd) + 1
If tmp(n) = -1 Then
GoTo NewNumber
Else
arr(j Mod 50000 + 1, k + 6 * (j \ 50000)) = tmp(n)
tmp(n) = -1
End If
Next k
Next j
Application.ScreenUpdating = False
Range("a1").Resize(50000, 28).ClearContents
Range("a1").Resize(50000, 24) = arr
For i = 19 To 7 Step -6
Columns(i).Insert
Next
Application.ScreenUpdating = True
End Sub





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Bernie Deitrick wrote :

 

[Paul Black]

Thanks Bernie & KeepITcool,

They both work Excellent, the one Posted by KeepITcool does Run a
little bit faster though.
Thanks Guys.

All the Best
Paul

 

[Paul Black]

Just One Further Request.
I decided I wanted to List One Million Sets of Six Random Numbers, it
did Produce them but did NOT insert a Blank Column Between Some of
them. I tried Several things but could NOT get it to work.
Any Help would be Appreciated.

All the Best
Paul

 

[keepITcool]

simplified it a bit.

Sub LottoGen()
Dim tmp&(1 To 49), arr&(1 To 50000, 1 To 6)
Dim s&, r&, c&, i&, n&

Application.ScreenUpdating = False
ActiveSheet.Cells.Clear
For s = 1 To 20
Erase arr
For r = 1 To 50000
For i = 1 To 49
tmp(i) = i
Next i
For c = 1 To 6
Randomize
NewNumber:
n = Int(49 * Rnd) + 1
If tmp(n) = -1 Then
GoTo NewNumber
Else
arr(r, c) = tmp(n)
tmp(n) = -1
End If
Next c
Next r
Cells(1, (s - 1) * 7 + 1).Resize(50000, 6) = arr
Next s
Application.ScreenUpdating = True
End Sub





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Paul Black wrote :

 

[Paul Black]

Thanks keepITcool, it works Brilliant and is VERY fast.

All the Best
Paul