View Single Post
  #23   Report Post  
Posted to microsoft.public.excel.programming
joeu2004[_2_] joeu2004[_2_] is offline
external usenet poster
 
Posts: 829
Default Unique Random Numbers

"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