Comments for "Excel VBA script to generate a list of 5 randomized draws (forum requested)"

A recent LP forum topic requested a script of some kind to generate randomized picks from the user's defined list of numbers.  I wrote (a number of years prior) an Excel VBA script that does this.  The script needs a tab labeled "Last" and then you put your list in the K column.  One interesting aspect to the macro 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'll see it show up more often in the outputted list of 5 randomized draws at range M1:Q5.  The script can be modified to output to generate more randomized draws and the intUniq variable can be changed to allow more or less numbers in your pool to randomize have the draws all be lower than a specified number, etc.  Once again, I used/borrowed the BubbleSort sub from John Walkenbach, who has written several great books on Excel and VBA for Excel; this sub sorts arrays, a handy function indeed.  I forget the reasons why goto statements are frowned upon, though I've stopped using them myself; forgive me if they offend your programming sensibilities.

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

Last Edited: March 16, 2011, 11:10 pm