Creating a Raffle (Random Name Generator with Constraints)

To have a button to do this will require VBA. I am moving your thread to that section of the forum.

OK. I created a macro to do the draw:

Public Sub DrawAllRaffles()

Dim lastRow As Long
Dim thisRow As Long

lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For thisRow = 3 To lastRow
    DrawRaffle thisRow
Next thisRow

End Sub
Public Sub DrawRaffle(thisRow As Long)

Dim quantity As Long
Dim entrants As New Collection
Dim thisCol As Long
Dim lastCol As Long
Dim winnerCol As Long
Dim drawNext As Long
Dim nextWinner As Long

' Get the quantity of prizes on offer
quantity = Cells(thisRow, "B").Value

' Find the last column
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column

' Add in all the entrants and keep track of the first "Winner" column
For thisCol = 3 To lastCol
    If StrComp(Left(Cells(2, thisCol).Value, 6), "winner", vbTextCompare) = 0 Then
        winnerCol = thisCol
        Exit For
    End If
    If Cells(thisRow, thisCol).Value = "X" Then entrants.Add Cells(2, thisCol).Value
Next thisCol

' Randomize
Randomize Now

' Fill in all the winner columns
For drawNext = winnerCol To lastCol
    ' If we've run out of prizes or entrants then put in a blank value
    If (drawNext - winnerCol >= quantity) Or (entrants.Count < 1) Then
        Cells(thisRow, drawNext).Value = "-"
    Else
        ' Draw a random person and then remove them from the draw
        nextWinner = Int(Rnd(1) * entrants.Count) + 1
        Cells(thisRow, drawNext).Value = entrants(nextWinner)
        entrants.Remove nextWinner
    End If
Next drawNext

End Sub

I then changed the buttons to be hyperlinks and trapped the follow event in the sheet:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

DrawRaffle Target.Range.Row

End Sub

It seems to work as desired. Note that you can also run "DrawAllRaffles" to draw them all rather than one at a time.

WBD

Originally Posted by aleemullah

Hi WBD,

This works perfectly. Thank you so much. You're a genius

Regards,
Aleem

No problem and no argument

WBD