Solved

# excel vba -- lucky draw program

Posted on 2007-07-29
Medium Priority
7,975 Views
Hi experts,

Is it possible to use excel vba to write a form/windows base program to implement a lucky draw?

i.e., Say I have 50 numbers and want to draw out 25, each time I press a button it will randomly pick a number from 1 - 50, without duplication... is it possible?

Or, is there any similar ready-user program on the Internet?
0
Question by:kennysflau
• 3
• 2
• 2
• +1

LVL 86

Expert Comment

ID: 19590137
Sure...add a CommandButton and a ListBox to a UserForm:

Option Explicit

Private numbers As Collection

Private Sub UserForm_Initialize()
Randomize Timer
End Sub

Private Sub CommandButton1_Click()
Dim i As Integer

If numbers Is Nothing Then
Set numbers = New Collection

For i = 1 To 50
Next i

ListBox1.Clear
End If

i = Int((numbers.Count - 1 + 1) * Rnd + 1)
numbers.Remove i
ListBox1.Selected(ListBox1.ListCount - 1) = True

If numbers.Count = 25 Then
MsgBox "25 numbers selected"
Set numbers = Nothing
End If
End Sub
0

Author Comment

ID: 19590334
Sorry but I have a stupid question.

I've inserted a userform with your code, but don't know how to run it
0

LVL 81

Expert Comment

ID: 19590479
Add the code below to any general code module. To use, select 25 cells in a column or row. Enter this formula in the formula bar:

=Drawing(1, 50)

and press CTRL+SHIFT+ENTER to enter the formula. Every time you calculate the sheet a new set of 25 unique random numbers will be generated from 1 to 50.

[Begin Code Segment]

Public Function Drawing( _
ByVal Min As Long, _
ByVal Max As Long, _
Optional ByVal PullOnce As Boolean = True _
) As Variant

' Implement as a UDF only. Returns a set of random integers pulled from a range of integers. To use, enter as a multiple cell array formula.
' If PullOnce is True (default) then each possible value occurs only once. If PullOnce is False then each possible value can occur any number of times.

Dim Sample As New Collection
Dim Result As Variant
Dim Number As Long
Dim Index As Long
Dim Column As Boolean
Dim Count As Long

Application.Volatile

If PullOnce And Max - Min + 1 < Application.Caller.Cells.Count Then
MsgBox "More results have been requested than possible draws. Increase the range of values or reduce the target range."
Exit Function
End If

If Application.Caller.Rows.Count > 1 And Application.Caller.Columns.Count > 1 Then
MsgBox "The target range of cells must be a single row or a single column."
Exit Function
End If

If Application.Caller.Rows.Count > 1 Then
Column = True
End If

For Number = Min To Max
Next Number

ReDim Result(0 To Application.Caller.Cells.Count - 1)

For Count = 1 To Application.Caller.Cells.Count
Index = Int(Rnd() * Sample.Count + 1)
Result(Count - 1) = Sample(Index)
If PullOnce Then
Sample.Remove Index
End If
Next Count

If Column Then
Drawing = Application.Transpose(Result)
Else
Drawing = Result
End If

End Function

[End Code Segment]

Kevin
0

Author Comment

ID: 19590708
Idle_Mind,

Sorry but I've tried to change 50 to 76 and 25 to 60... and program stopped after 16 or 17 clicks.
0

Author Comment

ID: 19590745
Hi Idle_Mind

it's ok... it should be Total No. - No. to draw...
however, I found that the pattern is always the same...
say I want to draw 60 out of 76... the pattern is always:
54, 41, 44, 22, 23....

I've tried 5 times and every time is just the same
0

LVL 81

Expert Comment

ID: 19590757
Is it a reasonable idea to list the results in a worksheet?

Kevin
0

LVL 86

Accepted Solution

Mike Tomlinson earned 1000 total points
ID: 19592980
Here ya go...

*** Note the "Randomize Timer" line in the UserForm_Initialize() sub (which was also in the original code)...without that line you will get the same sequence over and over ***

Option Explicit

Private lower As Integer
Private upper As Integer
Private numberToSelect As Integer
Private numbers As Collection

Private Sub UserForm_Initialize()
Randomize Timer
lower = 25
upper = 60
numberToSelect = 25
End Sub

Private Sub CommandButton1_Click()
Dim i As Integer

If numbers Is Nothing Then
Set numbers = New Collection

For i = lower To upper
Next i

ListBox1.Clear
End If

i = Int((numbers.Count - 1 + 1) * Rnd + 1)
numbers.Remove i
ListBox1.Selected(ListBox1.ListCount - 1) = True

If ListBox1.ListCount = numberToSelect Then
MsgBox numberToSelect & " numbers selected"
Set numbers = Nothing
End If
End Sub
0

Expert Comment

ID: 26394981
hi all,

my company is having a Dinner and Dance, and we want to have a lucky draw systems. we would like to pre-draw 300 prizes, download the lucky number and the related employee name into spreadsheet to be distributed. Futhermore, on the last draw of last 30 prizes, we want to draw the lucky number one-by-one. for example, if the lucky number is 0350, then the number 0, 3, 5, 0 will be displayed one-by-one..how can i modify the codes to do all these ?

0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you discover the power of the R programming language, you are going to wonder how you ever lived without it! Learn why the language merits a place in your programming arsenal.
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
###### Suggested Courses
Course of the Month8 days, left to enroll