I found a function for selecting random cells but it returns also duplicates.
Function RandomSelection(aRng As Range)
'Update20131113
Dim index As Integer
Randomize
index = Int(aRng.Count * Rnd + 1)
RandomSelection = aRng.Cells(index).Value
End Function
I need the function to do similar but without duplicates.
I would use a UDF() that returns an array:
Public Function NoRepeats(inpt As Range) As Variant
Dim ary(), nItems As Long, i As Long
Dim r As Range
nItems = inpt.Count
ReDim ary(1 To nItems)
i = 1
For Each r In inpt
ary(i) = r.Value
i = i + 1
Next r
Call Shuffle(ary)
ReDim temp(1 To nItems, 1 To 1)
For i = 1 To nItems
temp(i, 1) = ary(i)
Next i
NoRepeats = temp
End Function
Sub Shuffle(InOut() As Variant)
Dim HowMany As Long, i As Long, J As Long
Dim tempF As Double, temp As Variant
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For i = Low To Hi
Helper(i) = Rnd
Next i
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = temp
End If
Next i
For i = Hi - J To Low Step -1
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = temp
End If
Next i
J = J \ 2
Loop
End Sub
This has been coded to returns the results in column format, (see the dimming of temp in the UDF)
Note that the UDF() has been entered in array fashion with Ctrl + Shift + Enter rather than just the Enter key.
You could store each RandomSelection in a dictionary
Does VBA have Dictionary Structure?
and then before setting RandomSelection check the dictionary (Dictionary.exists(value)) to see if the value you are about to set it to has been used before.
