A while back, I wrote an Excel VBA script that generates randomized picks from the user's defined list. The script expects a tab labeled "Last" and then you
put your list in the K column. The cool thing is that let's say you think digit 39 is very likely to come up so you list it two, three times or more
in the list and you see it show up more often in the outputted list of 5 randomized draws at range M1:Q5. If this doesn't format cleanly, I added it to my
LP blog titled "Excel VBA script to generate a list of 5 randomized draws (forum requested)" .
Sub GenerateFiveRandDraws()
Dim x As Single, intDrw As Integer, ColRef As String, NumDy As Integer, sCol As String
Dim LastC5ol As String, intUniq As Integer, strDblChk As String, ChkRef As String, ArNums(1 To 5) As Integer
Dim Val1 As Integer, Val2 As Integer, Val3 As Integer, Val4 As Integer, Val5 As Integer, a As Integer, ValX As Integer
Dim rndstart As Single, intrndstart As Integer
Sheets("Last").Select
NumDy = 1
Do
intDrw = 1
Do
ColRef = Switch(intDrw = 1, "M", intDrw = 2, "N", intDrw = 3, "O", intDrw = 4, "P", intDrw = 5, "Q")
'accept RndNum iif it's in the list in Col, then test for no dupes
intUniq = 1
DoOVER:
Do
'''double rnd to start at different areas in UniqNums array
rndstart = Format((Rnd() * 0.31) * 100, "00")
intrndstart = CInt(rndstart)
intUniq = intrndstart + 1
x = Format((Rnd() * 0.39) * 100, "00")
LastCol = "K" & CStr(intUniq)
intUniq = intUniq + 1
If intUniq > 27 Then '''chng to 26 from 30
intUniq = 1
End If
''''embed a check here/perhaps send to sub w/more bias checks
If x = 0 Then
GoTo DoOVER
End If
Loop Until x = Range(LastCol).Value
sCol = ColRef & CStr(NumDy)
Range(sCol).Value = x
If intD5rw > 1 Then
ChkRef = Switch(intDrw = 2, "M", intDrw = 3, "N", intDrw = 4, "O", intDrw = 5, "P")
strDblChk = ChkRef & CStr(NumDy)
If Range(strDblChk).Value = Range(sCol).Value Then
GoTo DoOVER
ElseIf intDrw = 3 And Range(sCol).Value = Range("N" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 3 And Range(sCol).Value = Range("M" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 4 And Range(sCol).Value = Range("N" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 4 And Range(sCol).Value = Range("M" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("P" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("O" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("N" & CStr(NumDy) & "").Value Then
GoTo DoOVER
ElseIf intDrw = 5 And Range(sCol).Value = Range("M" & CStr(NumDy) & "").Value Then
GoTo DoOVER
End If
End If
intDrw = intDrw + 1
Loop Until intDrw > 5
Val1 = Range("M" & CStr(NumDy) & "").Value
Val2 = Range("N" & CStr(NumDy) & "").Value
Val3 = Range("O" & CStr(NumDy) & "").Value
Val4 = Range("P" & CStr(NumDy) & "").Value
Val5 = Range("Q" & CStr(NumDy) & "").Value
For a = 1 To 5
ValX = Switch(a = 1, Val1, a = 2, Val2, a = 3, Val3, a = 4, Val4, a = 5, Val5)
ArNums(a) = ValX
Next
a = a - 1
Call BubbleSort(ArNums())
Range("Q" & CStr(NumDy) & "").Value = ArNums(a)
Range("P" & CStr(NumDy) & "").Value = ArNums(a - 1)
Range("O" & CStr(NumDy) & "").Value = ArNums(a - 2)
Range("N" & CStr(NumDy) & "").Value = ArNums(a - 3)
Range("M" & CStr(NumDy) & "").Value = ArNums(a - 4)
If Range("M" & CStr(NumDy) & "").Value = Range("N" & CStr(NumDy) & "").Value Then
intDrw = 1
GoTo DoOVER
ElseIf Range("N" & CStr(NumDy) & "").Value = Range("O" & CStr(NumDy) & "").Value Then
intDrw = 2
GoTo DoOVER
ElseIf Range("O" & CStr(NumDy) & "").Value = Range("P" & CStr(NumDy) & "").Value Then
intDrw = 3
GoTo DoOVER
ElseIf Range("P" & CStr(NumDy) & "").Value = Range("Q" & CStr(NumDy) & "").Value Then
intDrw = 4
GoTo DoOVER
End If
NumDy = NumDy + 1
Loop Until NumDy > 5
MsgBox "done"
End Sub
'borrowed this from John Walkenbach, a writer of great Excel books
Sub BubbleSort(list() As Integer)
Dim First As Integer, Last As Integer, i As Integer, j As Integer, temp
First = LBound(list)
Last = UBound(list)
For i = First To Last - 1
For j = i + 1 To Last
If list(i) > list(j) Then
temp = list(j)
list(j) = list(i)
list(i) = temp
End If
Next j
Next i
End Sub