Random Sorts

Red wants to have a kind-of lottery for his students. He will award them prizes based on a random drawing, but wants to weight each student based on the number of assignments turned in. Normally, I would accomplish this by typing the name of each student in column A one time for every assignment he turned in. If John turned in three assignments, I’d type his name three times. In column B, I’d put a RAND() function and fill it down. Then I’d sort by column B. I’d get something that looks like this:

That’s all well and good, but it’s missing a few things. If I’m giving away three prizes, Sue wins them all unless I manually exclude her. But the worst part is that it happens too fast. Excel calculates so fast that it’s not entertaining to calculate in front of a group (unless you’re Charles Williams, of course). I wanted to come up with something that doesn’t allow ties, calculates more slowly, and is generally more friendly. Here’s my first stab

Behind the button, I have this code:

Public Sub DrawNext()
    Dim rNames As Range, rCell As Range
    Dim rLastICell As Range
    Dim i As Long
    Set rLastICell = wshDraws.Range(“I65536”).End(xlUp).Offset(1, 0)
    If rLastICell.Row > 2 Then
        Set rLastICell = rLastICell.Offset(-1)
        Set rNames = wshDraws.Range(“I2”, rLastICell)
        For Each rCell In rNames.Cells
            For i = 1 To 50
                rCell.Offset(0, 1).Value = Rnd * 1000
            Next i
        Next rCell
    End If
End Sub
Private Sub FillNames()
    Dim rNames As Range
    Dim rCell As Range, rEntry As Range
    Dim i As Long, j As Long
    Set rNames = wshDraws.Range(“I2”)
    Set rEntry = wshDraws.Range(“A2:A31”)
    j = 0
    For Each rCell In rEntry.Cells
        If Not IsEmpty(rCell.Value) Then
            For i = 1 To rCell.Offset(0, 1).Value
                rNames.Offset(j).Value = rCell.Value
                j = j + 1
            Next i
        End If
    Next rCell
End Sub

The user enters the information in columns A and B, up to 30 students. The code fills column I with one instance of each name for each assignment. Then for each name it fills in a random number between 0 and 999. For show, it fills each cell 50 times to make it look like it’s really doing some work.

In column C, I have this array formula


and in column D, this

=IF(RANK(C2,$C$2:$C$31)>3,””,CHOOSE(RANK(C2,$C$2:$C$31),”1st Place”,”2nd Place”,”3rd Place”))

There’s not a lot of error checking and far too many literals in the code, but it’s a start.

Download Lotter.zip. Yes, it’s 2003 format.

Posted in Uncategorized

11 thoughts on “Random Sorts

  1. Why not use VM software to create a VM with recalc speed circa 1985?

    Anyway, the draw could be accomplished with just 3 columns, Student Name/ID, number of assignments handed it, and number of assignments handed in times RAND(). Then select the 3 students with the highest values in the 3rd column.

    As for slowing down recalc, use a few unnecessary external references into closed files, e.g., add a cell showing the current date/time using the formula

    =NOW()+0*COUNTA(‘C: emp[foobar.xls]Sheet1’!$A$1:$IV$65536)

  2. I was a bit too fast with the formula for the 3rd column. If the 2nd column were B, then the 3rd column formula for row 5 should be


  3. For more excitement, you could add some conditional formatting to the cells so that “first” is blue, “second” red, etc.

  4. Hi,

    I tried to construct a formula, that would return some kind of weighted random number, so that you can use just one formula to get the results. The process went something like this:

    If you pick just one random number (RAND()), there is a 50% change that the number is greater (or equal) than 0.5.
    If you pick two random numbers, there is a 50% change that the maximum of those numbers >= 0.66666.
    If you pick three random numbers, there is a 50% change that the maximum of those numbers >= 0.75.

    Some kind of pattern is forming…

    If you pick n random numbers, there is a 50% change that the maximum of those numbers is >= 1-1/(n+1)

    Then I changed the perspective. Let’s say that a student has 8 completed assignments. I pick a random number, RAND(). If RAND() = 0.5, student should get a weighted value of 1-1/(8+1)=0.88888, but if the RAND() = 0, the weighted value should be 0 and if RAND()=1 => weighted value = 1.

    So I should scale the result to return a kind of logarithmic value. More there are completed assignments, greater the change to get a better weighted value. So the final function to use is this:


    – Asser

  5. Hey guys, I found out that I can install 2007 at work if I want. Are there any significant issues if I have both 2003 and 2007 installed?

  6. Charles – The issue may be that you still spend 95% of your time in 2003. I rarely go into 2007 other than to answer a question on a forum, or to test if something I’m doing also works in 2007 for future reference.

  7. Dick…I have a question. I have read through the script (I am a novice, by the way) but I can’t understand how Best Draw is calculated and if the drawing is truly random based on weighting. david.spencer@securit.com

  8. I’m using a version of this to run a weighted draft of pick order in our ultimate frisbee league based on level of donation. Thanks so much for the code.

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.