PowerPoint VBA Pick Items From a Hat Simulation

If you have a seriea of numbers or names then it's easy to select one at random using the formula

ItemChosen=Int(RND*Number of Items)+1

The problem comes when you want ato draw a second name or number. There's a chance that the same name will be chosen again. What we need to do is simulate drawing from a hat where the number or name chosen is REMOVED.

A common solution is to check numbers drawn against a list of numbers already used and if they match draw again. This of course isn't a true simulation and can take a while to run.

How To Use a Collection to Truly Simulate the Hat!

Step1:

'Declare hat as a New Collection

Dim hat As New Collection

'Now add this code. It first looks at the "hat" to see if it's empty and if not empties it and then adds the names / numbers from a list.

Sub fill_the_hat()
Dim items() As String
Dim x As Long
'remove any left over items
If hat.Count > 0 Then Call empty_the_hat()
'make a list seperated by \ - could be names or numbers any length
items = Split("Mary\Bill\John\Dawn\Ann\Colin", "\")
'add items one by one
For x = 0 To UBound(items)
hat.Add(items(x))
Next x
End Sub

Sub empty_the_hat()
'only called if hat has content
Dim x As Long
For x = 1 To hat.Count
hat.Remove(x)
Next x
End Sub

'Lastly the code to draw a name / number. Note how the item chosen is Removed.

Sub pick_one()
Dim x As Long
'is the hat empty
If hat.Count = 0 Then
MsgBox "All drawn"
Exit Sub
End If
'if not pick one at random and remove it
Randomize
x = Int(Rnd * hat.Count) + 1
MsgBox hat(x)
hat.Remove (x)
End Sub

As written the name chosen is displayed in a message box but you can easily adapt it to change text on your slide.