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:

Dim rNames As Range, rCell As Range

Dim rLastICell As Range

Dim i As Long

FillNames

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”)

wshDraws.Range(“I2:J65536”).ClearContents

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

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.

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)

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

=MAX((B5>0)*RAND(),(B5>1)*RAND(),(B5>2)*RAND(),

(B5>3)*RAND(),(B5>4)*RAND(),(B5>5)*RAND())

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

A visual (if it works)

Blayne – yeah, I like it. You have to use regular old HTML in these comments. I fixed it up for you.

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:

=RAND()^LOG(1-1/(n+1),0.5)

– Asser

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?

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.

I downloaded and used your lottery.xls…works fantastic! Thanks!

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

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.