View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein \(MVP - VB\)[_1741_] Rick Rothstein \(MVP - VB\)[_1741_] is offline
external usenet poster
 
Posts: 1
Default Formula to choose X number of unique random cells from array?

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 *******************



"Techhead" wrote in message
...
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