Pick Names At Random From A List – Excel VBA

April 24, 2020 Code VBA,

Pick Names At Random From A List – Excel VBA

In this blog post we will explore how to pick names at random from a list using Excel VBA.

Suppose we were picking the names for a draw or competition and needed to generate a list of maybe 3, 5 or any number of names from a list.

These names must be selected at random and be unique. You cannot select the same name more than once.

The macro code shown below can be copied and pasted into a VBA module and adapted for your use. Comments have been used to identify the key and more complex parts of the macro.

This macro uses an array variable to store the names being randomly selected from the list. Every time a name is selected, it is checked against this array to ensure that it has not already been selected. If it has, then another name is randomly selected.This macro demonstrates some key VBA techniques including a Do While and a For Next loop. It also uses variables including a string array and an If statement.

Macro to Pick Names at Random from a List

Sub PickNamesAtRandom()

Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names() As String 'Array to store randomly selected names
Dim i As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes

Application.ScreenUpdating = False

HowMany = Range("D3").Value
CellsOut = 6

ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("A:A")) - 1 ' Find how many names in the list
i = 1

Do While i <= HowMany
RandomNo:
    RandomNumber = Application.RandBetween(2, NoOfNames + 1)
    'Check to see if the name has already been picked
    For ArI = LBound(Names) To UBound(Names)
        If Names(ArI) = Cells(RandomNumber, 1).Value Then
            GoTo RandomNo
        End If
    Next ArI
    Names(i) = Cells(RandomNumber, 1).Value ' Assign random name to the array
    i = i + 1
Loop

'Loop through the array and enter names onto the worksheet
For ArI = LBound(Names) To UBound(Names)

    Cells(CellsOut, 4) = Names(ArI)
    CellsOut = CellsOut + 1

Next ArI

Application.ScreenUpdating = True

End Sub