Random name

[gleemonex69]

Good evening, Excel gods.
I would like to automate a raffle using Excel. I have a list of names in Tab NAMES and I would like to generate five winners in Tab WINNERS, without repeats. Preferably with a button that I can click to randomize the names. Thank you so much for your assistance.

 

[Eric W]

Let's say you have the header "Names" in A1 of your NAMES tab, and your names go from A2 to A100. The number can be higher or lower, and there may be unused cells in the range.

Now let's put the word "Winners" in A1 of your WINNERS tab. Then put this formula in A2 of that sheet:

=INDEX(NAMES!$A:$A,SMALL(IF(NAMES!$A$2:$A$100<>"",IF(COUNTIF(A$1:A1,NAMES!$A$2:$A$100)=0,ROW(NAMES!$A$2:$A$100))),RANDBETWEEN(1,COUNTA(NAMES!$A$2:$A$100)-ROWS($A$2:$A2)+1)))

and confirm it with Control+Shift+Enter. Change the NAMES!$A$2:$A$100 range as needed. Now copy it down to A6. This will generate a random list of 5 names, which will not repeat. Just press F9 to pick a different set.

 

[gleemonex69]

Fantastic!! Thank you so much. But here's another one. Let's say I have several different sets of names, all in different tabs (for different locations). Is it possible to use just one Raffle Tab?

 

[KevCarter]

Let's say you have the header "Names" in A1 of your NAMES tab, and your names go from A2 to A100. The number can be higher or lower, and there may be unused cells in the range.

Now let's put the word "Winners" in A1 of your WINNERS tab. Then put this formula in A2 of that sheet:

=INDEX(NAMES!$A:$A,SMALL(IF(NAMES!$A$2:$A$100<>"",IF(COUNTIF(A$1:A1,NAMES!$A$2:$A$100)=0,ROW(NAMES!$A$2:$A$100))),RANDBETWEEN(1,COUNTA(NAMES!$A$2:$A$100)-ROWS($A$2:$A2)+1)))

and confirm it with Control+Shift+Enter. Change the NAMES!$A$2:$A$100 range as needed. Now copy it down to A6. This will generate a random list of 5 names, which will not repeat. Just press F9 to pick a different set.

What an AMAZING Formula!!!

 

[Trebor76]

In case you need it, here is a macro solution:

Option Explicit
Sub Macro1()

    Dim lngStartRow As Long
    Dim lngLastRow As Long
    Dim lngNumOfWinners As Long
    Dim lngMyCounter As Long
    Dim lngPasteRow As Long
    Dim wsMySheet As Worksheet
    Dim dblMyRandomRow As Double
    Dim objNumsDrawn As Object
    
    Application.ScreenUpdating = False
    
    Set objNumsDrawn = CreateObject("Scripting.Dictionary")
    lngStartRow = 2 'Starting row number where the names are stored. Change to suit.
    Set wsMySheet = Sheets("Names") 'Sheet name containing names. Change to suit.
    lngLastRow = wsMySheet.Cells(Rows.Count, "A").End(xlUp).Row 'Last row number fom Col. A where the names are stored. Change to suit.
    lngNumOfWinners = 5 'Number of winners. Change to suit.
    
    Randomize 'Without this, the numbers drawn are the same.
        
    Do Until lngMyCounter = lngNumOfWinners
        dblMyRandomRow = Int((lngLastRow - lngStartRow + 1) * Rnd + lngStartRow) 'http://www.techonthenet.com/excel/formulas/rnd.php
        If objNumsDrawn.exists(CStr(dblMyRandomRow)) = False Then
            objNumsDrawn.Add CStr(dblMyRandomRow), lngMyCounter
            lngMyCounter = lngMyCounter + 1
            If lngPasteRow = 0 Then
                lngPasteRow = 2 'Initial output row in 'Winners' tab. Change to suit.
            Else
                lngPasteRow = lngPasteRow + 1
            End If
            Sheets("Winners").Range("A" & lngPasteRow).Value = Sheets("Names").Range("A" & dblMyRandomRow).Value
        End If
    Loop
    
    Set objNumsDrawn = Nothing
    Set wsMySheet = Nothing
    
    Application.ScreenUpdating = False
    
    MsgBox "Winners have been drawn!!", vbInformation
    
End Sub

Regards,

Robert

 

[Eric W]

gleemonx69: Glad you like it! Sure, you can add as many of these formulas as you like, just change the ranges to point to the different sheets. One possible issue is that when you press F9, they will all recalculate. You can possibly do a copy/pastespecial-values to save off the results you want to keep. If that gets a bit onerous, you can use a a macro solution such as Trebor76 suggested.

KevCarter: It is pretty cool! I can't take credit for it, I found it elsewhere and added it to my repertoire. But I had the same feeling the first time I saw it and deconstructed it, someone was really clever!