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

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

--
HTH,
Bernie
MS Excel MVP


"Paul Black" wrote in message
.. .
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..

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,

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

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



"keepITcool" wrote in message oft.com...
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,

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

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



(Paul Black) wrote in message m...
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



"keepITcool" wrote in message oft.com...
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,

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

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 :

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



(Paul Black) wrote in message
m...
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



"keepITcool" wrote in message
oft.com...
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,

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

Thanks keepITcool, it works Brilliant and is VERY fast.

All the Best
Paul



"keepITcool" wrote in message oft.com...
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 :

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



(Paul Black) wrote in message
m...
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



"keepITcool" wrote in message
oft.com...
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,

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