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.