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