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