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

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