Does anyone know of an efficient way to select M numbers from a list of 1 to N randomly?

[JenniferMurphy]

I need to write a UDF that will select M numbers from 1 to N randomly without replacement. That is, no duplicates.

I know I can write a loop that will select one random number, check if it has already been selected, repeat if it has. Something like this:

Function RandSelect(pM As Double, pN As Double) As Variant
Dim List() As Variant
ReDim List(1 To pN) As Variant
Dim i As Integer
Dim j As Integer

i = 0
RandSelect = ""
Do
  j = Int(Rnd() * pN) + 1
  If List(j) = 0 Then
    List(j) = 1
    RandSelect = RandSelect & " " & j
    i = i + 1
    If i >= pM Then Exit Do
  End If
Loop

End Function

This works, but it could take a while if N is large and M is close to N.

I don't see that either Excel or VBA have a function that will randomly reorder a list. If they do, I could do that and then just take the first M elements.

Thanks

 

[DanteAmor]

How about:

Function RandSelect(pM As Double, pN As Double) As Variant
  Dim i As Long, x As Long, y As Long
  Dim arr As Variant
  
  arr = Evaluate("=row(1:" & pN & ")")
  Randomize
  For i = 1 To UBound(arr)
    x = Int(UBound(arr) * Rnd + 1)
    y = arr(x, 1)
    arr(x, 1) = arr(i, 1)
    arr(i, 1) = y
  Next
  
  For i = 1 To pM
    RandSelect = RandSelect & " " & arr(i, 1)
  Next
End Function

 

[JenniferMurphy]

How about:

Brilliant! ??

Now I am kicking myself for not thinking about that approach. I was pondering moving items from one list to another as they are selected, but this is much better.

I have an enhancement to offer. In my application, the lists on the order of 1,000 items. I will need anywhere from 0 to maybe 20 random items at most. I see that your algorithm reorders the entire list regardless of the number requested. Here's my version which only loops pM times.

' My variation that stops after M iterations
Function RandSelect3(pM As Double, pN As Double) As Variant
 
  Dim iTo As Long     'Index of element to be swapped to
  Dim iFrom As Long   'Index of element to be swapped from
  Dim iToOld As Long  'Place to hold one element during swap
  Dim iLen As Long    'Remaining length of list
  Dim arr As Variant  'The list to be randomly reordered
 
  arr = Evaluate("row(1:" & pN & ")") 'Is "=" needed???
  Randomize
  iLen = pN           'Starting length
  For iTo = 1 To pM
    iFrom = Int(Rnd * iLen + iTo)   'Random number on [iTo,pN]
    iToOld = arr(iTo, 1)            'Save the current To item
    arr(iTo, 1) = arr(iFrom, 1)     'Move the From item to the To spot
    arr(iFrom, 1) = iToOld          'Move the old To item to the From spot
    RandSelect3 = RandSelect3 & " " & arr(iTo, 1)
    iLen = iLen - 1                 'Reduce the length for next loop
  Next iTo
 
End Function

Is there anything about this that is less "random" then your version? I tested it a bit and it seems random. ??

 

[JenniferMurphy]

Hmmm... It just occurred to me that my algorithm may have a randomness problem.

In the first loop, I generate a random number on [1,N]. Item #1 has an equal chance to take on any value.

In loop #2, I generate a random number on [2,N]. Item 2 has an equal chance for any of the numbers except the one in item 1. Does that affect the randomness? I;m not sure, but it's easy to change that to be [1,N] for all loops. I going to dinner now, but I'll do that when I return.

 

[DanteAmor]

Is there anything about this that is less "random" then your version?

Okay, your version is also random, and I guess it works for what you need. Because you only want the first m random numbers.

 

[bebo021999]

@DanteAmor, your pN was limited as 1.048.576 (maximum rows limit), though it does not effect to OP' requirement.
My solution is, using dictionary to test dupplication, and While...Loop to repeat the random numbers, if its dupplicate.
Like this:

Function RandSelect3(pM As Double, pN As Double)
Dim dic As Object
Dim rNum&, key
Set dic = CreateObject("scripting.dictionary")
If pM > pN Then
    MsgBox "Invalid Number!"
    Exit Function
End If
Randomize
rNum = Int(pN * Rnd + 1)
dic.Add rNum, "" ' first random number added
    For i = 2 To pM ' 2nd to last random numbers added
        Do While dic.exists(rNum) ' that mean if random number repeat, continue to generate  other random number
            rNum = Int(pN * Rnd + 1)
        Loop
        dic.Add rNum, ""
    Next
    For Each key In dic.keys
        RandSelect3 = RandSelect3 & " " & key
    Next
End Function