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.
Want to improve your Excel VBA skills. Take our online course to master Excel VBA quickly.
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
Watch the Video
More Awesome Excel VBA Tutorials
- Macro to Export All Worksheets as PDF
- Great Tip to Add a Hyperlink to a Userform
- Format Specific Words in a Cell using Excel VBA
- Create a Hangman Game in Excel