Unique Random Numbers

  • Thread starter Thread starter Paul Black
  • Start date Start date
hi Paul,

i put the macro in the following file and there is no error messages, canyou try ithttp://cjoint.com/?AIkn7wfgBAw
Click to expand...

Hi Isabelle,

Thanks for the macro but unfortunately the result gives me a number in
every cell of the grid which is not exactly what I am after.
The reason being is that if I used 49 numbers producing 6 number
combinations that should equate to 8 rows with 6 numbers and 1 row
with 1 number.
Thanks for your help and time on this Isabelle.

Kind regards,
Paul
 
Paul Black said:
I have tried to adapt the code slightly to have two input boxes pop up
initially, the first asking the maximum number to be Randomized and
the second to ask how many numbers there are in each combination. [....]
nFrom = Application.InputBox("How Many Numbers Would You Like To
Randomize?",
"Shuffle Size", Type:=1)
nDrawn = Application.InputBox("How Many Numbers In Each Combination?",
"Combination Size", Type:=1)
Click to expand...

Try the macro below.

-----

Option Explicit

Sub Shuffle()

' ***** customize*****
Const rAddress As String = "b2"
Const clrAddress As String = "b:k"
' *****

Dim i As Long, j As Long
Dim nPool As Long, nCol As Long, nRow As Long
Dim r As Range

Randomize

nPool = Application.InputBox("How Many Numbers Would You " & _
"Like To Randomize?", "Shuffle Size", Type:=1)
If nPool <= 0 Then End

nCol = Application.InputBox("How Many Numbers In Each " & _
"Combination?", "Combination Size", Type:=1)
If nCol <= 0 Then End

' determine range of output.
If nCol > nPool Then nCol = nPool
nRow = Int((nPool + nCol - 1) / nCol) ' round up
Set r = Range(rAddress).Resize(nRow, nCol)

' clear any previous data
Columns(clrAddress).ClearContents

' initialize pool of numbers for random drawings
ReDim num(1 To nPool) As Long
For i = 1 To nPool: num(i) = i: Next

For i = 1 To nPool
' draw next random number.
' store into range, across columns first,
' then down rows
j = 1 + Int(nPool * Rnd())
r(i) = num(j)

' remove num(j) from pool of numbers
If j < nPool Then num(j) = num(nPool)
nPool = nPool - 1
Next

End Sub
 
I said:
Try the macro below.
Click to expand...

As you requested, that macro might generate an irregular combination -- i.e.
fewer than normal -- if nPool is not an exact multiple of nCol.

If you reach a point where you realize that you would prefer to avoid the
irregular combination (I would), use the following macro instead.

-----

Option Explicit

Sub Shuffle()

' ***** customize*****
Const rAddress As String = "b2"
Const clrAddress As String = "b:k"
' *****

Dim i As Long, j As Long, n As Long
Dim nPool As Long, nCol As Long, nRow As Long
Dim r As Range

Randomize

nPool = Application.InputBox("How Many Numbers Would You " & _
"Like To Randomize?", "Shuffle Size", Type:=1)
If nPool <= 0 Then End

nCol = Application.InputBox("How Many Numbers In Each " & _
"Combination?", "Combination Size", Type:=1)
If nCol <= 0 Then End

' determine range of output.
If nCol > nPool Then nCol = nPool
nRow = Int(nPool / nCol)

' clear any previous data
Columns(clrAddress).ClearContents

' initialize pool of numbers for random drawings
ReDim num(1 To nPool) As Long
For i = 1 To nPool: num(i) = i: Next

n = nRow * nCol
If n > nPool Then n = nPool

For i = 1 To n
' draw next random number.
' store into range, across columns first,
' then down rows
j = 1 + Int(nPool * Rnd())
r(i) = num(j)

' remove num(j) from pool of numbers
If j < nPool Then num(j) = num(nPool)
nPool = nPool - 1
Next

End Sub
 
I said:
If you reach a point where you realize that you would
prefer to avoid the irregular combination (I would),
use the following macro instead. [....]
' determine range of output.
If nCol > nPool Then nCol = nPool
nRow = Int(nPool / nCol)
Click to expand...

Oops, I dropped a line in my copy-and-pasting somehow. Insert the following
line after the lines above:

Set r = Range(rAddress).Resize(nRow, nCol)
 
As you requested, that macro might generate an irregular combination -- i..e.
fewer than normal -- if nPool is not an exact multiple of nCol.

If you reach a point where you realize that you would prefer to avoid the
irregular combination (I would), use the following macro instead.

-----

Option Explicit

Sub Shuffle()

' ***** customize*****
Const rAddress As String = "b2"
Const clrAddress As String = "b:k"
' *****

Dim i As Long, j As Long, n As Long
Dim nPool As Long, nCol As Long, nRow As Long
Dim r As Range

Randomize

nPool = Application.InputBox("How Many Numbers Would You " & _
            "Like To Randomize?", "Shuffle Size", Type:=1)
If nPool <= 0 Then End

nCol = Application.InputBox("How Many Numbers In Each " & _
            "Combination?", "Combination Size", Type:=1)
If nCol <= 0 Then End

' determine range of output.
If nCol > nPool Then nCol = nPool
nRow = Int(nPool / nCol)

' clear any previous data
Columns(clrAddress).ClearContents

' initialize pool of numbers for random drawings
ReDim num(1 To nPool) As Long
For i = 1 To nPool: num(i) = i: Next

n = nRow * nCol
If n > nPool Then n = nPool

For i = 1 To n
    ' draw next random number.
    ' store into range, across columns first,
    ' then down rows
    j = 1 + Int(nPool * Rnd())
    r(i) = num(j)

    ' remove num(j) from pool of numbers
    If j < nPool Then num(j) = num(nPool)
    nPool = nPool - 1
Next

End Sub
Click to expand...

Hi Joe,

I have run the code but it gives me an error Run-time error '91'
Object variable or With block variable not set.
I have googled for an answer but there does not seem to be a solution
for my particular problem.
The error is on line ...

r(i) = num(j)

Thanks in advance,
Paul
 
Hi Joe,

I have run the code but it gives me an error Run-time error '91'
Object variable or With block variable not set.
I have googled for an answer but there does not seem to be a solution
for my particular problem.
The error is on line ...

r(i) = num(j)

Thanks in advance,
Paul
Click to expand...

Hi Joe,

Please ignore the previous post, I was looking at sheet one and not
sheet two of this thread, appologies.
Your macro gives the data required, thank you.
I will try and adapt your macro so that when I use 49 numbers (or
whatever) and 6 number combinations that instead of giving me just 8
lines of 6 numbers that it gives me 8 lines of 6 numbers and 1 line of
1 number.
Thanks again.

Kind regards,
Paul
 
Paul Black said:
As you requested, that macro might generate an irregular
combination -- i.e. fewer than normal -- if nPool is not
an exact multiple of nCol.
Click to expand...
If you reach a point where you realize that you would prefer
to avoid the irregular combination (I would), use the
following macro instead.
Click to expand...
[....]
I will try and adapt your macro so that when I use 49 numbers
(or whatever) and 6 number combinations that instead of giving
me just 8 lines of 6 numbers that it gives me 8 lines of 6
numbers and 1 line of 1 number.
Click to expand...

No adaptation is needed. You are using the wrong one of the __two__ macros
that I posted.

Since you do indeed want the irregular combination, you should use the first
version that I posted.

I will repost it below. Sorry for the confusion.

-----

Option Explicit

Sub Shuffle()

' ***** customize*****
Const rAddress As String = "b2"
Const clrAddress As String = "b:k"
' *****

Dim i As Long, j As Long
Dim nPool As Long, nCol As Long, nRow As Long
Dim r As Range

Randomize

nPool = Application.InputBox("How Many Numbers Would You " & _
"Like To Randomize?", "Shuffle Size", Type:=1)
If nPool <= 0 Then End

nCol = Application.InputBox("How Many Numbers In Each " & _
"Combination?", "Combination Size", Type:=1)
If nCol <= 0 Then End

' determine range of output.
If nCol > nPool Then nCol = nPool
nRow = Int((nPool + nCol - 1) / nCol) ' round up
Set r = Range(rAddress).Resize(nRow, nCol)

' clear any previous data
Columns(clrAddress).ClearContents

' initialize pool of numbers for random drawings
ReDim num(1 To nPool) As Long
For i = 1 To nPool: num(i) = i: Next

For i = 1 To nPool
' draw next random number.
' store into range, across columns first,
' then down rows
j = 1 + Int(nPool * Rnd())
r(i) = num(j)

' remove num(j) from pool of numbers
If j < nPool Then num(j) = num(nPool)
nPool = nPool - 1
Next

End Sub
 
Back
Top