Hi,

I would like to generate unique random numbers from say 34 numbers,
and starting in "B2" list them in 5 number combinations going down
until ALL the 34 numbers have been used. I know in this example the
first 6 combinations will have 5 numbers and the 7th combination will
have only 4.
There may be occassions where there might be more or less numbers than
34 numbers and maybe 4,5,6 or 7 number combinations so code where I
could adapt it accordingly will be much appreciated.

Thanks in advance,
Paul

"Paul Black" wrote:
I would like to generate unique random numbers from say 34
numbers, and starting in "B2" list them in 5 number
combinations going down until ALL the 34 numbers have been
used. I know in this example the first 6 combinations will
have 5 numbers and the 7th combination will have only 4.
There may be occassions where there might be more or less
numbers than 34 numbers and maybe 4,5,6 or 7 number
combinations

See the UDF below. Use as you would RANDBETWEEN, e.g.
=uniqRandBetween(1,34).

Each uniqRandBetween range has its own pool of unique random numbers. So
two calls to uniqRandBetween(1,34) will generate a unique pair of numbers;
but a call to uniqRandBetween(1,34) and uniqRandBetween(1,20) might result
in the same random number.

As currently configured, uniqRandBetween supports up to 10 different ranges,
each with a maximum range of 100 values (hi - lo + 1). Change the Const
variable maxNTabl and maxN as needed.

To enter the UDF, in Excel, press alt+F8 to open the VBA window. In VBA,
click on Insert, then Module to open a VBE pane. Copy the text of the UDF
below and paste it into the VBE pane. You can now close the VBA window.

The UDF....

Option Explicit

Function uniqRandBetween(lo As Long, hi As Long)

'***** customize *****
' maxNtabl = number of lo-to-hi ranges
' maxN = max size of range, hi-lo+1
'******
Const maxNtabl As Long = 10
Const maxN As Long = 100

Static tabl(1 To maxNtabl, 1 To 3 + maxN) As Long
Static ntabl As Long
Dim t As Long, n As Long, x As Long

' find table for lo-to-hi range

If lo hi Then GoTo retnError
For t = 1 To ntabl
If tabl(t, 1) = lo And tabl(t, 2) = hi Then GoTo continue
Next
If ntabl = maxNtabl Then GoTo retnError
If hi - lo + 1 maxN Then GoTo retnError
ntabl = ntabl + 1
t = ntabl
tabl(t, 1) = lo
tabl(t, 2) = hi
tabl(t, 3) = 0

continue:

' generate list of random numbers, if needed

n = tabl(t, 3)
If n = 0 Then
For n = 1 To hi - lo + 1
tabl(t, 3 + n) = lo + n - 1
Next
n = n - 1
End If

' generate unique random number.
'
' note: you might want to change Rnd to
' Evaluate("RAND()") to use Excel RAND.
' slower, but more maybe robust.

x = 1 + Int(n * Rnd)
uniqRandBetween = tabl(t, 3 + x)
If x < n Then tabl(t, 3 + x) = tabl(t, 3 + n)
tabl(t, 3) = n - 1
Exit Function

retnError:

uniqRandBetween = CVErr(xlErrValue)
End Function

On 08/09/2011 01:26, Paul Black wrote:
Hi,

I would like to generate unique random numbers from say 34 numbers,
and starting in "B2" list them in 5 number combinations going down
until ALL the 34 numbers have been used. I know in this example the
first 6 combinations will have 5 numbers and the 7th combination will
have only 4.
There may be occassions where there might be more or less numbers than
34 numbers and maybe 4,5,6 or 7 number combinations so code where I
could adapt it accordingly will be much appreciated.

The simplest way is to define them as 1...N sequentially and then
shuffle them with code to swap a pair chosen at random from the cells
range 1..N run this O(N^2) times and you get what you want.

Regards,
Martin Brown

On Sep 8, 8:17*am, "joeu2004" wrote:
"Paul Black" wrote:
I would like to generate unique random numbers from say 34
numbers, and starting in "B2" list them in 5 number
combinations going down until ALL the 34 numbers have been
used. I know in this example the first 6 combinations will
have 5 numbers and the 7th combination will have only 4.
There may be occassions where there might be more or less
numbers than 34 numbers and maybe 4,5,6 or 7 number
combinations

See the UDF below. *Use as you would RANDBETWEEN, e.g.
=uniqRandBetween(1,34).

Each uniqRandBetween range has its own pool of unique random numbers. *So
two calls to uniqRandBetween(1,34) will generate a unique pair of numbers;
but a call to uniqRandBetween(1,34) and uniqRandBetween(1,20) might result
in the same random number.

As currently configured, uniqRandBetween supports up to 10 different ranges,
each with a maximum range of 100 values (hi - lo + 1). *Change the Const
variable maxNTabl and maxN as needed.

To enter the UDF, in Excel, press alt+F8 to open the VBA window. *In VBA,
click on Insert, then Module to open a VBE pane. *Copy the text of the UDF
below and paste it into the VBE pane. *You can now close the VBA window..

The UDF....

Option Explicit

Function uniqRandBetween(lo As Long, hi As Long)

'***** customize *****
' maxNtabl = number of lo-to-hi ranges
' maxN = max size of range, hi-lo+1
'******
Const maxNtabl As Long = 10
Const maxN As Long = 100

Static tabl(1 To maxNtabl, 1 To 3 + maxN) As Long
Static ntabl As Long
Dim t As Long, n As Long, x As Long

' find table for lo-to-hi range

If lo hi Then GoTo retnError
For t = 1 To ntabl
* * If tabl(t, 1) = lo And tabl(t, 2) = hi Then GoTo continue
Next
If ntabl = maxNtabl Then GoTo retnError
If hi - lo + 1 maxN Then GoTo retnError
ntabl = ntabl + 1
t = ntabl
tabl(t, 1) = lo
tabl(t, 2) = hi
tabl(t, 3) = 0

continue:

' generate list of random numbers, if needed

n = tabl(t, 3)
If n = 0 Then
* * For n = 1 To hi - lo + 1
* * * * tabl(t, 3 + n) = lo + n - 1
* * Next
* * n = n - 1
End If

' generate unique random number.
'
' note: *you might want to change Rnd to
' Evaluate("RAND()") to use Excel RAND.
' slower, but more maybe robust.

x = 1 + Int(n * Rnd)
uniqRandBetween = tabl(t, 3 + x)
If x < n Then tabl(t, 3 + x) = tabl(t, 3 + n)
tabl(t, 3) = n - 1
Exit Function

retnError:

uniqRandBetween = CVErr(xlErrValue)
End Function

Thank you both for the replies.
Unfortunately the UDF produces replica numbers.
What I would prefer is a Sub that produces 5,6,7 or whatever number
combinations without replacement until ALL the numbers have been used.
So for example, if there were 40 numbers and I wanted 6 number
combinations there would be 6 combinations with 6 numbers and 1
combination with 4 numbers so using ALL the 40 numbers only once.
I could then manually change the Sub to meet my future requirements.

Thanks again,
Paul

On Sep 8, 11:36*am, Paul Black wrote:
On Sep 8, 8:17*am, "joeu2004" wrote:





"Paul Black" wrote:
I would like to generate unique random numbers from say 34
numbers, and starting in "B2" list them in 5 number
combinations going down until ALL the 34 numbers have been
used. I know in this example the first 6 combinations will
have 5 numbers and the 7th combination will have only 4.
There may be occassions where there might be more or less
numbers than 34 numbers and maybe 4,5,6 or 7 number
combinations

See the UDF below. *Use as you would RANDBETWEEN, e.g.
=uniqRandBetween(1,34).

Each uniqRandBetween range has its own pool of unique random numbers. *So
two calls to uniqRandBetween(1,34) will generate a unique pair of numbers;
but a call to uniqRandBetween(1,34) and uniqRandBetween(1,20) might result
in the same random number.

As currently configured, uniqRandBetween supports up to 10 different ranges,
each with a maximum range of 100 values (hi - lo + 1). *Change the Const
variable maxNTabl and maxN as needed.

To enter the UDF, in Excel, press alt+F8 to open the VBA window. *In VBA,
click on Insert, then Module to open a VBE pane. *Copy the text of the UDF
below and paste it into the VBE pane. *You can now close the VBA window.

The UDF....

Option Explicit

Function uniqRandBetween(lo As Long, hi As Long)

'***** customize *****
' maxNtabl = number of lo-to-hi ranges
' maxN = max size of range, hi-lo+1
'******
Const maxNtabl As Long = 10
Const maxN As Long = 100

Static tabl(1 To maxNtabl, 1 To 3 + maxN) As Long
Static ntabl As Long
Dim t As Long, n As Long, x As Long

' find table for lo-to-hi range

If lo hi Then GoTo retnError
For t = 1 To ntabl
* * If tabl(t, 1) = lo And tabl(t, 2) = hi Then GoTo continue
Next
If ntabl = maxNtabl Then GoTo retnError
If hi - lo + 1 maxN Then GoTo retnError
ntabl = ntabl + 1
t = ntabl
tabl(t, 1) = lo
tabl(t, 2) = hi
tabl(t, 3) = 0

continue:

' generate list of random numbers, if needed

n = tabl(t, 3)
If n = 0 Then
* * For n = 1 To hi - lo + 1
* * * * tabl(t, 3 + n) = lo + n - 1
* * Next
* * n = n - 1
End If

' generate unique random number.
'
' note: *you might want to change Rnd to
' Evaluate("RAND()") to use Excel RAND.
' slower, but more maybe robust.

x = 1 + Int(n * Rnd)
uniqRandBetween = tabl(t, 3 + x)
If x < n Then tabl(t, 3 + x) = tabl(t, 3 + n)
tabl(t, 3) = n - 1
Exit Function

retnError:

uniqRandBetween = CVErr(xlErrValue)
End Function

Thank you both for the replies.
Unfortunately the UDF produces replica numbers.
What I would prefer is a Sub that produces 5,6,7 or whatever number
combinations without replacement until ALL the numbers have been used.
So for example, if there were 40 numbers and I wanted 6 number
combinations there would be 6 combinations with 6 numbers and 1
combination with 4 numbers so using ALL the 40 numbers only once.
I could then manually change the Sub to meet my future requirements.

Thanks again,
Paul

Actually, this code does what I want other than produce the
combinations until ALL the numbers have been used.
The thing is it resets ALL the numbers before producing the next
combination which is not what I want, I want it to produce
combinations until ALL the numbers have been used only once.

Sub Main()

Dim nDrawnMain As Long ' Total MAIN numbers drawn for each
combination.
Dim nFromMain As Long ' Total MAIN numbers to be drawn from.
Dim nComb As Long ' Total number of random combinations to
be produced.
Dim myMain() As Variant ' MAIN array.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

nDrawnMain = 7 ' Total MAIN numbers drawn
nFromMain = 34 ' Total MAIN numbers drawn from

Worksheets("Rand").Select

With ActiveSheet
.Columns("A:K").ClearContents ' Clear the current combinations
ready for the new combinations
ReDim myMain(1 To nFromMain) ' Re-dimension the MAIN array
nComb = .Range("N18").Value ' Number of combinations to be
produced
End With

Randomize

For j = 1 To nComb ' Number of random combinations to be produced

' Reinitialize MAIN array before producing a new combination
For h = 1 To nFromMain ' Total numbers to be drawn from
myMain(h) = h
Next h

n = nFromMain ' Total MAIN numbers to be drawn from
For k = 1 To nDrawnMain ' Total MAIN numbers drawn
h = Int(n * Rnd) + 1
Range("B2").Offset(j - 1, k - 1) = myMain(h)
If h < n Then myMain(h) = myMain(n)
n = n - 1
Next k

Next j

Range("O18").Select

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Thanks again,
Paul

Paul Black wrote :
On Sep 8, 11:36*am, Paul Black wrote:
On Sep 8, 8:17*am, "joeu2004" wrote:





"Paul Black" wrote:
I would like to generate unique random numbers from say 34
numbers, and starting in "B2" list them in 5 number
combinations going down until ALL the 34 numbers have been
used. I know in this example the first 6 combinations will
have 5 numbers and the 7th combination will have only 4.
There may be occassions where there might be more or less
numbers than 34 numbers and maybe 4,5,6 or 7 number
combinations

See the UDF below. *Use as you would RANDBETWEEN, e.g.
=uniqRandBetween(1,34).

Each uniqRandBetween range has its own pool of unique random numbers. *So
two calls to uniqRandBetween(1,34) will generate a unique pair of numbers;
but a call to uniqRandBetween(1,34) and uniqRandBetween(1,20) might result
in the same random number.

As currently configured, uniqRandBetween supports up to 10 different
ranges, each with a maximum range of 100 values (hi - lo + 1). *Change the
Const variable maxNTabl and maxN as needed.
To enter the UDF, in Excel, press alt+F8 to open the VBA window. *In VBA,
click on Insert, then Module to open a VBE pane. *Copy the text of the UDF
below and paste it into the VBE pane. *You can now close the VBA window.
The UDF....

Option Explicit

Function uniqRandBetween(lo As Long, hi As Long)
'***** customize *****
' maxNtabl = number of lo-to-hi ranges
' maxN = max size of range, hi-lo+1
'******
Const maxNtabl As Long = 10
Const maxN As Long = 100

Static tabl(1 To maxNtabl, 1 To 3 + maxN) As Long
Static ntabl As Long
Dim t As Long, n As Long, x As Long

' find table for lo-to-hi range

If lo hi Then GoTo retnError
For t = 1 To ntabl
* * If tabl(t, 1) = lo And tabl(t, 2) = hi Then GoTo continue
Next
If ntabl = maxNtabl Then GoTo retnError
If hi - lo + 1 maxN Then GoTo retnError
ntabl = ntabl + 1
t = ntabl
tabl(t, 1) = lo
tabl(t, 2) = hi
tabl(t, 3) = 0

continue:

' generate list of random numbers, if needed
n = tabl(t, 3)
If n = 0 Then
* * For n = 1 To hi - lo + 1
* * * * tabl(t, 3 + n) = lo + n - 1
* * Next
* * n = n - 1
End If

' generate unique random number.
'
' note: *you might want to change Rnd to
' Evaluate("RAND()") to use Excel RAND.
' slower, but more maybe robust.

x = 1 + Int(n * Rnd)
uniqRandBetween = tabl(t, 3 + x)
If x < n Then tabl(t, 3 + x) = tabl(t, 3 + n)
tabl(t, 3) = n - 1
Exit Function

retnError:

uniqRandBetween = CVErr(xlErrValue)
End Function

Thank you both for the replies.
Unfortunately the UDF produces replica numbers.
What I would prefer is a Sub that produces 5,6,7 or whatever number
combinations without replacement until ALL the numbers have been used.
So for example, if there were 40 numbers and I wanted 6 number
combinations there would be 6 combinations with 6 numbers and 1
combination with 4 numbers so using ALL the 40 numbers only once.
I could then manually change the Sub to meet my future requirements.

Thanks again,
Paul

Actually, this code does what I want other than produce the
combinations until ALL the numbers have been used.
The thing is it resets ALL the numbers before producing the next
combination which is not what I want, I want it to produce
combinations until ALL the numbers have been used only once.

Sub Main()

Dim nDrawnMain As Long ' Total MAIN numbers drawn for each
combination.
Dim nFromMain As Long ' Total MAIN numbers to be drawn from.
Dim nComb As Long ' Total number of random combinations to
be produced.
Dim myMain() As Variant ' MAIN array.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

nDrawnMain = 7 ' Total MAIN numbers drawn
nFromMain = 34 ' Total MAIN numbers drawn from

Worksheets("Rand").Select

With ActiveSheet
.Columns("A:K").ClearContents ' Clear the current combinations
ready for the new combinations
ReDim myMain(1 To nFromMain) ' Re-dimension the MAIN array
nComb = .Range("N18").Value ' Number of combinations to be
produced
End With

Randomize

For j = 1 To nComb ' Number of random combinations to be produced

' Reinitialize MAIN array before producing a new combination
For h = 1 To nFromMain ' Total numbers to be drawn from
myMain(h) = h
Next h

n = nFromMain ' Total MAIN numbers to be drawn from
For k = 1 To nDrawnMain ' Total MAIN numbers drawn
h = Int(n * Rnd) + 1
Range("B2").Offset(j - 1, k - 1) = myMain(h)
If h < n Then myMain(h) = myMain(n)
n = n - 1
Next k

Next j

Range("O18").Select

Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Thanks again,
Paul

Try storing the used numbers in a variant and check if your Rnd process
returns a stored number BEFORE adding it to the result.

I'd also store the results in an array and 'dump' it into the wks in
one shot rather than write the wks every iteration of your loop. Doing
the process in memory will ALWAYS be faster than read/write ranges as
you go.<IMO

What if the number of combinations in Range("N18") is more than the
possible combinations available? You should probably include a check
for that!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Joe,
Perhaps you could include a variant to store already used numbers and
check each newly generated number to see if it's already been used
BEFORE adding to the result.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

On Sep 8, 3:19*pm, GS wrote:
Joe,
Perhaps you could include a variant to store already used numbers and
check each newly generated number to see if it's already been used
BEFORE adding to the result.

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thanks for the replies Garry.
Actually, the code I posted was mainly conceived by people with far
more knowledge than myself, I still don't fully understand how the
above code works, but it does, so I will have great difficulty in
applying the methods you have kindly put forward.

Kind regards,
Paul

Paul Black explained :
On Sep 8, 3:19*pm, GS wrote:
Joe,
Perhaps you could include a variant to store already used numbers and
check each newly generated number to see if it's already been used
BEFORE adding to the result.

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Thanks for the replies Garry.
Actually, the code I posted was mainly conceived by people with far
more knowledge than myself, I still don't fully understand how the
above code works, but it does, so I will have great difficulty in
applying the methods you have kindly put forward.

Kind regards,
Paul

Paul,
This reply was meant for joeu2004. His code looks like it will work
with my suggestion and so I'm happy to let him revise it to his liking.
Hopefully, he'll get back to you soon.<g

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

"Paul Black" wrote:
Unfortunately the UDF produces replica numbers.
What I would prefer is a Sub that produces 5,6,7
or whatever number combinations without replacement
until ALL the numbers have been used.

It does exactly that if you put =uniqRandBetween(1,34) into 34 different
cells in any arrangement that you wish. (Previously, you mention 6 rows of
5 and 1 row of 4.)

I wrote:
"Paul Black" wrote:
Unfortunately the UDF produces replica numbers.
What I would prefer is a Sub that produces 5,6,7
or whatever number combinations without replacement
until ALL the numbers have been used.

It does exactly that if you put =uniqRandBetween(1,34)
into 34 different cells in any arrangement that you wish.
(Previously, you mention 6 rows of 5 and 1 row of 4.)

After populating the 34 cells as your desire, you can generate a new set of
34 unique random values by pressing ctrl+alt+F9.

Alternatively, you could execute the following macro, changing the cell
arrangement as you wish.

Sub genAll()
Dim i as Long, j as Long
Randomize
For i = 1 to 6
For j = 1 to 5
Cells(i,j) = uniqRandBetween(1,34)
Next
Next
For j = 1 to 5
Cells(7,j) = uniqRandBetween(1,34)
Next
End Sub

On Sep 8, 9:05*pm, "joeu2004" wrote:
I wrote:
"Paul Black" wrote:
Unfortunately the UDF produces replica numbers.
What I would prefer is a Sub that produces 5,6,7
or whatever number combinations without replacement
until ALL the numbers have been used.

It does exactly that if you put =uniqRandBetween(1,34)
into 34 different cells in any arrangement that you wish.
(Previously, you mention 6 rows of 5 and 1 row of 4.)

After populating the 34 cells as your desire, you can generate a new set of
34 unique random values by pressing ctrl+alt+F9.

Alternatively, you could execute the following macro, changing the cell
arrangement as you wish.

Sub genAll()
Dim i as Long, j as Long
Randomize
For i = 1 to 6
* * For j = 1 to 5
* * * *Cells(i,j) = uniqRandBetween(1,34)
* * Next
Next
For j = 1 to 5
* * Cells(7,j) = uniqRandBetween(1,34)
Next
End Sub

Thanks for your reply Joe.
I have been surfing the web and have come to the conclusion that I
have probably been asking completely the wrong question.
It appears that I need a Sub that "Shuffles" an array.
Unfortunately I can't find one that accommodates exactly what I am
after, which is basically being able to designate the size of the
array (e.g. 34 numbers or 40 numbers or 45 numbers etc) and then
choose whether I want them listed as 4 number combinations, 5 number
combinations or 6 number combinations for example starting in cell
"B2".
If you have any code that does this I would be grateful.

Thanks,
Paul

hello Paul,

do you use excel to do this?
if so, why not use table with "ReDim Preserve"
and check the contents with "Application.Match"
dont forget, you can set a table outside of the macro to maintain content and then change this content.

--
isabelle




Le 2011-09-08 19:07, Paul Black a écrit :

Thanks for your reply Joe.
I have been surfing the web and have come to the conclusion that I
have probably been asking completely the wrong question.
It appears that I need a Sub that "Shuffles" an array.
Unfortunately I can't find one that accommodates exactly what I am
after, which is basically being able to designate the size of the
array (e.g. 34 numbers or 40 numbers or 45 numbers etc) and then
choose whether I want them listed as 4 number combinations, 5 number
combinations or 6 number combinations for example starting in cell
"B2".
If you have any code that does this I would be grateful.

Thanks,
Paul

On Sep 9, 3:56*am, isabelle wrote:
hello Paul,

do you use excel to do this?
if so, why not use table with "ReDim Preserve"
and check the contents with *"Application.Match"
dont forget, you can set a table outside of the macro to maintain content and then change this content.

--
isabelle

Le 2011-09-08 19:07, Paul Black a écrit :

- Show quoted text -

Thanks for the reply Isabelle.
Unfortunately my knowledge of VBA is not that great.
I have managed however to put the following code together but
unfortunately it produces the final number 3 times for some reason.
Could you please have a look at it to see what I am doing wrong
please.
Here is the code ...

Sub Shuffle()
Dim Number()

Worksheets("Sheet1").Select

With ActiveSheet
.Columns("A:K").ClearContents
End With

On Error Resume Next

LastNumber = 49

Set ArrayRange = ActiveSheet.Range(Cells(2, 2), Cells(10, 7))

ReDim Number(LastNumber)

For i = 1 To LastNumber
Number(i) = i
Next i

For Each c In ArrayRange
Placement = Int(Rnd() * LastNumber + 1)
c.Value = Number(Placement)
dummy = Number(LastNumber)
Number(LastNumber) = Number(Placement)
Number(Placement) = dummy
LastNumber = LastNumber - 1
Next c

On Error GoTo 0
End Sub

Thanks,
Paul

hi Paul,

Arrayrange is not equal to 49 but 54
you can change this line
LastNumber = 49
for
LastNumber = ActiveSheet.Range (Cells (2, 2), Cells (10, 7)). Count

--
isabelle


Le 2011-09-09 09:52, Paul Black a écrit :

Thanks for the reply Isabelle.
Unfortunately my knowledge of VBA is not that great.
I have managed however to put the following code together but
unfortunately it produces the final number 3 times for some reason.
Could you please have a look at it to see what I am doing wrong
please.
Here is the code ...

Sub Shuffle()
Dim Number()

Worksheets("Sheet1").Select

With ActiveSheet
.Columns("A:K").ClearContents
End With

On Error Resume Next

LastNumber = 49

Set ArrayRange = ActiveSheet.Range(Cells(2, 2), Cells(10, 7))

ReDim Number(LastNumber)

For i = 1 To LastNumber
Number(i) = i
Next i

For Each c In ArrayRange
Placement = Int(Rnd() * LastNumber + 1)
c.Value = Number(Placement)
dummy = Number(LastNumber)
Number(LastNumber) = Number(Placement)
Number(Placement) = dummy
LastNumber = LastNumber - 1
Next c

On Error GoTo 0
End Sub

Thanks,
Paul

On Sep 9, 3:51*pm, isabelle wrote:
hi Paul,

Arrayrange is not equal to 49 but 54
you can change this line
LastNumber = 49
for
LastNumber = ActiveSheet.Range (Cells (2, 2), Cells (10, 7)). Count

--
isabelle

Le 2011-09-09 09:52, Paul Black a crit :



Thanks for the reply Isabelle.
Unfortunately my knowledge of VBA is not that great.
I have managed however to put the following code together but
unfortunately it produces the final number 3 times for some reason.
Could you please have a look at it to see what I am doing wrong
please.
Here is the code ...

Sub Shuffle()
Dim Number()

Worksheets("Sheet1").Select

With ActiveSheet
* * *.Columns("A:K").ClearContents
End With

On Error Resume Next

LastNumber = 49

Set ArrayRange = ActiveSheet.Range(Cells(2, 2), Cells(10, 7))

ReDim Number(LastNumber)

For i = 1 To LastNumber
* * *Number(i) = i
Next i

For Each c In ArrayRange
* * *Placement = Int(Rnd() * LastNumber + 1)
* * *c.Value = Number(Placement)
* * *dummy = Number(LastNumber)
* * *Number(LastNumber) = Number(Placement)
* * *Number(Placement) = dummy
* * *LastNumber = LastNumber - 1
Next c

On Error GoTo 0
End Sub

Thanks,
Paul- Hide quoted text -

- Show quoted text -

Thanks Isabelle but it still does not work.

Kind regards,
Paul

On Sep 9, 4:00*pm, Paul Black wrote:
On Sep 9, 3:51*pm, isabelle wrote:





hi Paul,

Arrayrange is not equal to 49 but 54
you can change this line
LastNumber = 49
for
LastNumber = ActiveSheet.Range (Cells (2, 2), Cells (10, 7)). Count

--
isabelle

Le 2011-09-09 09:52, Paul Black a crit :

Thanks for the reply Isabelle.
Unfortunately my knowledge of VBA is not that great.
I have managed however to put the following code together but
unfortunately it produces the final number 3 times for some reason.
Could you please have a look at it to see what I am doing wrong
please.
Here is the code ...

Sub Shuffle()
Dim Number()

Worksheets("Sheet1").Select

With ActiveSheet
* * *.Columns("A:K").ClearContents
End With

On Error Resume Next

LastNumber = 49

Set ArrayRange = ActiveSheet.Range(Cells(2, 2), Cells(10, 7))

ReDim Number(LastNumber)

For i = 1 To LastNumber
* * *Number(i) = i
Next i

For Each c In ArrayRange
* * *Placement = Int(Rnd() * LastNumber + 1)
* * *c.Value = Number(Placement)
* * *dummy = Number(LastNumber)
* * *Number(LastNumber) = Number(Placement)
* * *Number(Placement) = dummy
* * *LastNumber = LastNumber - 1
Next c

On Error GoTo 0
End Sub

Thanks,
Paul- Hide quoted text -

- Show quoted text -

Thanks Isabelle but it still does not work.

Kind regards,
Paul- Hide quoted text -

- Show quoted text -

One other thing.
If I do not use the "On Error Resume Next" I get a Run-time error '9',
is this something to do with defining the Array or Variables.

Thanks again,
Paul

On Sep 9, 4:05*pm, Paul Black wrote:
On Sep 9, 4:00*pm, Paul Black wrote:





On Sep 9, 3:51*pm, isabelle wrote:

hi Paul,

Arrayrange is not equal to 49 but 54
you can change this line
LastNumber = 49
for
LastNumber = ActiveSheet.Range (Cells (2, 2), Cells (10, 7)). Count

--
isabelle

Le 2011-09-09 09:52, Paul Black a crit :

Thanks for the reply Isabelle.
Unfortunately my knowledge of VBA is not that great.
I have managed however to put the following code together but
unfortunately it produces the final number 3 times for some reason.
Could you please have a look at it to see what I am doing wrong
please.
Here is the code ...

Sub Shuffle()
Dim Number()

Worksheets("Sheet1").Select

With ActiveSheet
* * *.Columns("A:K").ClearContents
End With

On Error Resume Next

LastNumber = 49

Set ArrayRange = ActiveSheet.Range(Cells(2, 2), Cells(10, 7))

ReDim Number(LastNumber)

For i = 1 To LastNumber
* * *Number(i) = i
Next i

For Each c In ArrayRange
* * *Placement = Int(Rnd() * LastNumber + 1)
* * *c.Value = Number(Placement)
* * *dummy = Number(LastNumber)
* * *Number(LastNumber) = Number(Placement)
* * *Number(Placement) = dummy
* * *LastNumber = LastNumber - 1
Next c

On Error GoTo 0
End Sub

Thanks,
Paul- Hide quoted text -

- Show quoted text -

Thanks Isabelle but it still does not work.

Kind regards,
Paul- Hide quoted text -

- Show quoted text -

One other thing.
If I do not use the "On Error Resume Next" I get a Run-time error '9',
is this something to do with defining the Array or Variables.

Thanks again,
Paul- Hide quoted text -

- Show quoted text -

Hi Isabelle, I forgot to say the error is on line ...

dummy = Number(LastNumber)

Thanks,
Paul

"Paul Black" wrote:
Unfortunately my knowledge of VBA is not that great.
I have managed however to put the following code together
but unfortunately it produces the final number 3 times
for some reason.

You almost got it right. A number of small mistakes. Instead of explaining
each one, I suggest that you simply use the macro below.

Instead of putting the macro into a module and relaying on
Worksheets("Sheet1").Select to ensure that the correct worksheet is
modified, I suggest that you put the macro in the worksheet object. That
allows you to rename the worksheet without having to change the macro.

To do that, right-click on the worksheet tab at the bottom of the Excel
window, click on View Code, then copy the macro and paste it into the VBE
pane in the VBA window. Then you can close the VBA window, if you wish.

Programming note.... This is not the most efficient implementation. But
it might be easier to understand as is.

-----

Option Explicit

Sub Shuffle()

' ***** customize*****
Const nMax As Long = 49
Const rAddress As String = "b2:g10"
Const clrAddress As String = "b:k"
' *****

Dim i As Long, j As Long, n As Long
Dim r As Range

' change #If 0 to #If 1 to generate same random
' sequence each time for debugging purposes
#If 0 Then
i = Rnd(-1)
Randomize 1
#Else
Randomize
#End If

Set r = Range(rAddress)

' clear any previous data
Columns(clrAddress).ClearContents

' generate up to nMax random numbers.
' generate fewer if range is smaller than nMax
n = IIf(nMax <= r.Count, nMax, r.Count)

' initialize set of random numbers, 1 to nMax
ReDim num(1 To n) As Long
For i = 1 To n: num(i) = i: Next

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

' remove num(j) from set of random numbers
If j < n Then num(j) = num(n)
n = n - 1
Next

End Sub

On Sep 10, 8:13*am, "joeu2004" wrote:
"Paul Black" wrote:
Unfortunately my knowledge of VBA is not that great.
I have managed however to put the following code together
but unfortunately it produces the final number 3 times
for some reason.

You almost got it right. *A number of small mistakes. *Instead of explaining
each one, I suggest that you simply use the macro below.

Instead of putting the macro into a module and relaying on
Worksheets("Sheet1").Select to ensure that the correct worksheet is
modified, I suggest that you put the macro in the worksheet object. *That
allows you to rename the worksheet without having to change the macro.

To do that, right-click on the worksheet tab at the bottom of the Excel
window, click on View Code, then copy the macro and paste it into the VBE
pane in the VBA window. *Then you can close the VBA window, if you wish..

Programming note.... * This is not the most efficient implementation. *But
it might be easier to understand as is.

-----

Option Explicit

Sub Shuffle()

' ***** customize*****
Const nMax As Long = 49
Const rAddress As String = "b2:g10"
Const clrAddress As String = "b:k"
' *****

Dim i As Long, j As Long, n As Long
Dim r As Range

' change #If 0 to #If 1 to generate same random
' sequence each time for debugging purposes
#If 0 Then
* * i = Rnd(-1)
* * Randomize 1
#Else
* * Randomize
#End If

Set r = Range(rAddress)

' clear any previous data
Columns(clrAddress).ClearContents

' generate up to nMax random numbers.
' generate fewer if range is smaller than nMax
n = IIf(nMax <= r.Count, nMax, r.Count)

' initialize set of random numbers, 1 to nMax
ReDim num(1 To n) As Long
For i = 1 To n: num(i) = i: Next

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

* * ' remove num(j) from set of random numbers
* * If j < n Then num(j) = num(n)
* * n = n - 1
Next

End Sub

Hi Joe, excellent, THANK YOU.
I will go through your code and get a better understanding of what is
happening.

Kind regards,
Paul

hi Paul,

i put the macro in the following file and there is no error messages, can you try it
http://cjoint.com/?AIkn7wfgBAw

--
isabelle

On Sep 10, 1:11*pm, isabelle wrote:
hi Paul,

i put the macro in the following file and there is no error messages, can you try ithttp://cjoint.com/?AIkn7wfgBAw

--
isabelle

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" wrote:
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)

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 wrote:
Try the macro below.

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 wrote:
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)

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)

On Sep 10, 2:24*pm, "joeu2004" wrote:
I wrote:
Try the macro below.

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

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

On Sep 11, 11:47*am, Paul Black wrote:
On Sep 10, 2:24*pm, "joeu2004" wrote:





I wrote:
Try the macro below.

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

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,

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" wrote:
On Sep 10, 2:24 pm, "joeu2004" wrote:
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.
[....]
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.

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