Formula to choose X number of unique random cells from array?

[Techhead]

How would I create a formula to choose X number of unique cells from
an array? For example,

A1 = Bob
A2 = Mary
A3 = Bill
A4 = Tom
A5 = Dick


I need to choose at random, 3 of these names and they have to be
unique. On a larger scale, I have a database of 1500 names and I need
to select 50 unique names (cells) at random.

Thanks,
Brian

 

[Jean-Yves]

Hi,

Add a formual in next column with function "RAND( )"
Sort on that column and take the first 50.
The rand function will also be recalculted each time a sortin is done.

 

[Rick Rothstein \(MVP - VB\)]

Copy/Paste the code below my signature into your worksheet's code window.
The RandomizeArray subroutine takes an array and shuffles its contents
around randomly so that you can simply read off the top so many elements of
the shuffled array to guarantee that you have that many unique, randomly
selected items. The GetUniqueNames macro performs the necessary call to the
RandomizeArray subroutine so you don't have to do anything except set your
worksheet parameters in its various Const(ant) statement.

Rick

'******************* Start Of Code *******************
Sub GetUniqueNames()
Dim X As Long
Dim LastRow As Long
Dim Names() As String
Const NamesInColumn As String = "A"
Const NamesInStartRow As Long = 1
Const NamesOutColumn As String = "B"
Const NamesOutStartRow As Long = 1
Const NumberNamesToReturn As Long = 50
With Worksheets("Sheet4")
LastRow = .Cells(.Rows.Count, NamesInColumn).End(xlUp).Row
ReDim Names(0 To LastRow - NamesInStartRow)
For X = NamesInStartRow To LastRow
Names(X - NamesInStartRow) = .Cells(X, NamesInColumn).Value
Next
RandomizeArray Names
For X = NamesOutStartRow To NamesOutStartRow + NumberNamesToReturn - 1
.Cells(X, NamesOutColumn).Value = Names(X)
Next
End With
End Sub

Sub RandomizeArray(ArrayIn As Variant)
Dim X As Long
Dim RandomIndex As Long
Dim TempElement As Variant
Static RanBefore As Boolean
If Not RanBefore Then
RanBefore = True
Randomize
End If
If VarType(ArrayIn) >= vbArray Then
For X = UBound(ArrayIn) To LBound(ArrayIn) Step -1
RandomIndex = Int((X - LBound(ArrayIn) + 1) * _
Rnd + LBound(ArrayIn))
TempElement = ArrayIn(RandomIndex)
ArrayIn(RandomIndex) = ArrayIn(X)
ArrayIn(X) = TempElement
Next
Else
'The passed argument was not an array
'Put error handler here, such as . . .
Beep
End If
End Sub
'******************* End Of Code *******************

 

[Rick Rothstein \(MVP - VB\)]

I forgot to mention, you also need to change the worksheet's name in the
With statement from the "Sheet4" example name I used to the actual name of
your worksheet.

You could, if you wanted more flexibility, remove the Const statements and
the hard coded worksheet name from the code area and create an argument list
for the GetUniqueNames macro (the changing it to a normal subroutine) and
then, in a separate macro, simply call that GetUniqueNames subroutine
passing in the arguments for that particular run of your macro.

Rick

 

[Techhead]

Hi,

Add a formual in next column with function "RAND( )"
Sort on that column and take the first 50.
The rand function will also be recalculted each time a sortin is done.

--
Regards

Jean-Yves Tfelt
Europe








- Show quoted text -

Putting RAND() on the next column over only gives me a decimal
numerical value. How would I apply the RAND() function on Column A?

 

[Jean-Yves]

Hi

Assume the name are in column A, and the Rand function in B ( you have to
fill down until you reach the last row of the namwe column.
Sort column A & B on B.
Then take the first 50 entries in column A.