PowerPoint vba - Names from a hat simulation

This article shows how to simulate drawing numbers or names from a hat or bag using vba in PowerPoint and prevents duplicate items being selected.

It’s not difficult to choose a (semi) random number in vba. The RND function returns a decimal number between zero and 1 (but never 1) so we can easily use it to produce any range. This produces a number between 1 and 10 for example.

Dim myNumber as Long
                      Randomize
                      myNumber=INT(RND  * 10)+1 
                      

Select all Open in new window

A more general formula to produce a range of numbers not starting with one would be:

myNumber = INT(RND * the number of items) + lowest number
                      

Select all Open in new window

so to produce a a number in the range 3 to 10 (8 numbers starting with 3)

myNumber=INT(RND * 8)+3
                      

Select all Open in new window

Note that RND is not truly random and the use of randomize resets the seed to increase its variability.

Real Life Scenario:
Consider now drawing a name or number from a hat. Once drawn that number is discarded and cannot be drawn again. You can continue drawing numbers or names confident that you won’t see any duplicates.  This doesn’t happen with RND so there is a chance a name or number can be drawn more than once. This is obviously not desirable!
Perhaps the obvious answer is to check each choice to make sure it has not been used and then to redraw until a unique name or number is selected.  This will work but if most of the numbers or names have already been selected there may be a large number of ‘used’ items selected.

Using a Collection in vba can closely simulate the real life hat though by removing selections as they are drawn. Here’s how it works.

First the “myHat” Collection is created by declaring it as a new Collection. Then we fill the collection with the names or numbers. Using the random number method one of the items in the collection is selected. A message box informs us of the choice and then this item is deleted so that it cannot be used again.

Sub From_Hat()
                      'Declare the collection
                      Dim myHat As New Collection
                      Dim names() As String
                      Dim x As Long
                      Dim iChoice As Integer
                      
                      'load names (or numbers) into an array using SPLIT
                      'you can use a longer list!
                      names = Split("Bob\Mary\Joe\John", "\")
                      'Bob will be names(0) and John names(3)
                      
                      'load into the new collection
                      For x = 0 To UBound(names)
                      myHat.Add (names(x))
                      Next x
                      
                      Do
                      Randomize
                      'choose a random name
                      iChoice = Int(Rnd * myHat.Count) + 1
                      MsgBox myHat(iChoice)
                      'remove that choice
                      myHat.Remove (iChoice)
                      Loop Until myHat.Count = 0
                      MsgBox "All chosen"
                      End Sub
                      
                      You should be able to modify the code easily to create other similar simulations.
                      If you need a range of numbers instead of names then you can omit the array and slit and just use a simple loop to load the collection.
                      
                      e.g.
                      
                      'load into the new collection
                      For x = 1 To 99
                      myHat.Add (x)
                      Next x
                      

Select all Open in new window

You might also want to put a message box to enable a jump out of the loop when enough names have been chosen.

Do
                      Randomize
                      'choose a random name
                      iChoice = Int(Rnd * myHat.Count) + 1
                      If MsgBox("The choice is " & myHat(iChoice) _
                      & vbCrLf & "Choose again?", vbYesNo) <> vbYes Then Exit Do
                      'remove that choice
                      myHat.Remove (iChoice)
                      Loop Until myHat.Count = 0
                      

Select all Open in new window

Conclusion

This is an efficient way of selecting items when you cannot have any duplicates. As written it reports to a message box but it could be easily modified to change text in a shape on a slide.