?
Solved

excel vba -- lucky draw program

Posted on 2007-07-29
8
Medium Priority
?
7,975 Views
Last Modified: 2012-06-21
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
Comment
Question by:kennysflau
  • 3
  • 2
  • 2
  • +1
8 Comments
 
LVL 86

Expert Comment

by:Mike Tomlinson
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
            numbers.Add i
        Next i
       
        ListBox1.Clear
    End If
   
    i = Int((numbers.Count - 1 + 1) * Rnd + 1)
    ListBox1.AddItem numbers(i)
    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

by:kennysflau
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

by:zorvek (Kevin Jones)
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
      Sample.Add Number
   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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:kennysflau
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

by:kennysflau
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

by:zorvek (Kevin Jones)
ID: 19590757
Is it a reasonable idea to list the results in a worksheet?

Kevin
0
 
LVL 86

Accepted Solution

by:
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
            numbers.Add i
        Next i
       
        ListBox1.Clear
    End If
   
    i = Int((numbers.Count - 1 + 1) * Rnd + 1)
    ListBox1.AddItem numbers(i)
    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

by:sameboat
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

Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

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…

616 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question