How to create a raffle on excel where there are multiple entries that varies on clients purchase amo-CodePudding

I do have a list of people for a raffle. The supervisor told me that the number of entry will vary depending on their purchase amount:
$1 - 59$: 1 Raffle Ticket
$60 - $200: 5 Raffle Tickets
$201 - $600: 10 Raffle Tickets
$601 - Max: 15 Raffle Ticket

My thoughts are I'll create a column wherein I'll apply a condition for the purchase amount and give it a score.

And after how would I randomly pick a winner applying the multiple entry as a higher chance of winning?

CodePudding user response：

asking a computer to do something random isn't really possible. But this example comes close. It takes the list of purchasers and creates the appropriate number of tickets for them. Then "shuffles" those tickets, randomly picks a group and then randomly picks a name from that group. It will produce a different answer every time.

Sub OneSolution()
        Dim x As Long, y As Long, z As Long, TheName As String, x1 As Long
        y = 1 ' output row index
        z = 1 ' simple key for sorting, limited to max tickets per, or 15
        MaxTicketHolders = 13 ' set accordingly
        For x = 1 To MaxTicketHolders
                        TheName = Cells(x, 1).Value ' the ticket holders name
                Select Case Cells(x, 2).Value ' Purchase Amount
                        Case Is < 60
                                generateTickets 1, y, z, TheName
                        Case Is < 201
                                generateTickets 5, y, z, TheName
                        Case Is < 601
                                generateTickets 10, y, z, TheName
                        Case Else
                                generateTickets 15, y, z, TheName
                End Select
        Next x
        'sort tickets by simple key, grouping names into 15 groups
        y = y - 1
        With ActiveSheet.Sort
                .SortFields.Clear
                .SortFields.Add2 Key:=Range("K1:K" & y)
                .SetRange Range("J1:K" & y)
                .Apply
        End With
        Randomize
        x = Int(10 * Rnd   1) 'randomly pick a group from the 15 groups
        Cells(1, 12) = "=countif(K1:K" & y & "," & x & ")"
        y = Cells(1, 12) 'number of tickets in that group
        Set r = Columns("K:K").Find(what:=x)
        If Not r Is Nothing Then
                x1 = r.Row ' first row in that group
        Else
                End 'shouldnt happen
        End If
        z = Int(y * Rnd)  'randomly pick a name from that group
        y = x1   z
        MsgBox "The Name is " & Cells(y, 10) & " ticket: " & y
        
End Sub
Sub generateTickets(cnt As Integer, y As Long, z As Long, TheName As String)
        Dim j As Long
        For j = 1 To cnt
                Cells(y, 10) = TheName
                Cells(y, 11) = z
                z = z   1
                If z > 15 Then z = 1
                y = y   1
        Next j
End Sub

CodePudding user response：

I think you can impress your supervisor using the next function:

Function RaffleChances() As String
   Dim arr(), ticketsNo As Long, rndExtract As Long
   
   Application.Volatile
   ticketsNo = 1   5   10   15 '31 total tickets to play with
   arr() = Evaluate("TRANSPOSE(ROW(1:" & ticketsNo & "))") 'build an array containing all tikets from 1 to 31
   'Debug.Print Join(arr, "|") 'uncheck to see the built array in Immediate Window
   Randomize
   rndExtract = Int((UBound(arr) - LBound(arr)   1) * Rnd   LBound(arr)) 'randomly extract a tiket number (from 1 to 31)

   Select Case rndExtract 'choose the winner:
         Case 1: RaffleChances = "Player 1 wan!"
         Case 2 To 6: RaffleChances = "Player 2 wan!"
         Case 7 To 16: RaffleChances = "Player 3 wan!"
         Case 17 To 31: RaffleChances = "Player 4 wan!"
   End Select
End Function

It assumes that there are tickets from 1 to 31 and the have been allocated to the buyers starting from 1 to 31 (number-series)...

You can see how it works using the next testing Sub:

Sub testRaffleChances()
   MsgBox RaffleChances
End Sub

Run this Sub and see how many times a specific tickets buyer win.

A better checking approach would be to use the function as UDF (User Defined Function). Please, write the next formula in "A2" cell:

   =RaffleChances()

Then, fill down the formula and count each raffle participant how many times would wan, according to the bought number of tickets...

But do it on a large range. Statistics works on big populations... :)

Then, press F9 key to trigger Calculate event and visually follow the winners. You can also place a CountIf formula to specifically count how many times each player/participant wins. I mean, something like that:

="Player 1 wan "&COUNTIF(A:A,"Player 1 wan!")&" times…"
="Player 2 wan "&COUNTIF(A:A,"Player 2 wan!")&" times…"
' and so on...