Most Valuable Professional


View Jan Karel Pieterse's profile on LinkedIn subscribe to rss feed
Subscribe in a reader

Subscribe to our mailing list

* indicates required

Audit !!!

Check out our RefTreeAnalyser
the ultimate Excel formula auditing tool.

Trainings

Excel VBA Masterclass (English)
Excel VBA for Financials (Dutch)

Third party tools

Speed up your file

FastExcel
The best tool to optimise your Excel model!

What has changed?

PerfectXL Compare, for Spreadsheet Comparison
This Excel compare tool is fast, reliable, and easy to use. Compare two Excel files now and see for yourself!
Home > English site > Articles > Wheel of Fortune

Creating a Wheel Of Fortune with Excel

Introduction

Excel is a very serious and powerful business application. That doesn't mean we can't have some fun with it. In this article I'll explain how I've built an Excel file which enables you to play with a wheel of fortune. With sound and all!

This is what it'll look like when we're done:

Wheel Of Fortune In Excel

Download the accompanying file from here

Generating the numbers

Getting random numbers isn't hard in Excel, that is what the RAND() function is for. We'll use a two-column table. The first column contains whole numbers 1 ... 300. The second contains the =RAND() function. When we're about to do a draw, we simply sort the table on column B. This is what our table looks like (worksheet Step 1):

Wheel Of Fortune In Excel, the data

Worksheet Step 2 shows the prepared list of numbers, still in their 1, 2, 3 order. I've picked a rather arbitrary cell as the "drawn number cell", in this case cell A14. So after a recalc and sort, cell A14 already displays our winning number. The winner is 13. Column D will hold our previous winners.

Boring of course. We want animation!

Animating the numbers

On worksheet Step 3 we'll start using the table on sheet Step 2. I've left the table in 1, 2, 3 sort for now so we can easily see how it works.

Cell C3 contains a fixed number. We'll start incrementing that number when we start a draw. Cells C4:C28 contain a simple formula: =C3+1. So as soon as we add 1 to cell C3, 1 will be added to all cells below that too.

We'll use these numbers to pick the numbers from the previous worksheet, using the OFFSET function. See Cell G3: =OFFSET('Step 2'!$A$1,C3,0,1,1)

Try entering 1, 2, 3, 4 into cell C3 and see what happens. If you're quick enough, the numbers will appear to be moving.

Controlling the highest possible number in the draw

I needed a way to set a maximum number (the wheel of fortune was used at an event and we didn't know up front how many participants there would be). Worksheet Step 4 demonstrates how this was done.

In cell B1 the max number is set. This cell is used by some formulas AND by a little VBA macro we'll get to later.

Lets have a look at column D. It contains this formula: =MOD(C3,$B$1)+1. In effect, this formula causes the numbers to "roll over": to restart at 1, as soon as a cell in col C reaches the maximum value. And I've modified the formula in column F to now use column D for the index, rather than column C. Try entering a number into cell C3 which is close to the current max in cell B1 and you'll see what I mean:

Wheel Of Fortune In Excel, max items

Making it look like a wheel

So now that we've got the numbers right, lets do some formatting.

Click on sheet "Wheel 1". You'll see I've removed all helper columns, leaving just our list of numbers for the wheel and the pointer to the winning cell:

Wheel Of Fortune In Excel, Just the numbers

On Sheet Wheel 2 I have added some colors and borders. This is starting to look nice!

Wheel Of Fortune In Excel, Creating a wheel step 1

Lets turn to Sheet Wheel 3. I've added quite some trickery there!

Wheel Of Fortune In Excel, Creating a wheel step 2

Sheet Wheel 4 shows the one-but-last stage, where I have modified row heights and column widths. Pretty?

Wheel Of Fortune In Excel, Creating a wheel step 3

Lets turn to sheet Play.

Wheel Of Fortune In Excel, Creating a wheel step 4

Notice the flashy letters? Conditional formatting again!

Alas, the wheel doesn't turn without some VBA code.

VBA code

I'm going to be a bit lazy and just dump the code here. There are two  modules.

Module modPlay

The trickery here is that this routine called "SpinIt" auto-adjusts itself so that it'll take precisely 18 seconds to finish turning the wheel. Why? Because I've added sound effects and the sound effect file (WheelOfFortune.wav) takes 18 seconds to play!

Option Explicit

Dim mlLoopFactor As Long

Sub SpinIt()
    Dim lCT As Long
    Dim lCt2 As Long
    Dim lCount As Long
    Dim dTime As Double
    Dim dStart As Double
    Dim bOK As Boolean
    If mlLoopFactor = 0 Then mlLoopFactor = 5000
    lCount = Worksheets("Step 4").Range("B1").Value
    Application.ScreenUpdating = False
    With Worksheets("Step 2")
        Do
            Application.Calculate
            .Range("A1:B300").Sort Key1:=.Range("A1"), _
                                   Order1:=xlAscending, Header:=xlYes, _
                                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                   DataOption1:=xlSortNormal

            .Range("A1:B" & lCount + 1).Sort Key1:=.Range("B1"), _
                                              Order1:=xlAscending, Header:=xlYes, _
                                              OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                              DataOption1:=xlSortNormal
            bOK = Add2Numbers(.Range("A14").Value)
        Loop Until bOK
    End With
    Application.ScreenUpdating = True
    PlayBackLoop
    dStart = Timer
    With Worksheets("Step 4")
        For lCT = lCount To 0 Step -1
            .Range("C3").Value = lCT
            '            DoEvents
            dTime = Timer
            Do
            Loop Until Timer - dTime > (lCount - lCT) / mlLoopFactor
        Next
    End With
    dStart = (Timer - dStart)

    '17.5/time*(1/loopcounter)

    mlLoopFactor = 1 / (17.5 / dStart * (1 / mlLoopFactor))
    PlayBackStop
    Application.Wait Now + TimeValue("00:00:01")
    Range("Result").Speak
End Sub

Function Add2Numbers(lValue As Long) As Boolean
    Dim ocell As Range
    Dim oSh As Worksheet
    Set oSh = Worksheets("Step 2")
    Set ocell = oSh.Range("D2:D1000").Find(lValue, oSh.Range("D2"), xlValues, xlWhole, , xlNext, False, , False)
    If ocell Is Nothing Then
        Add2Numbers = True
        oSh.Range("D" & oSh.Rows.Count).End(xlUp).Offset(1).Value = lValue
    Else
        Add2Numbers = False
    End If
End Function

Public Sub ResetNumbers(Optional bAsk As Boolean = True)
    Dim oSh As Worksheet
    Dim bDo As Boolean
    Set oSh = Worksheets("Step 2")
    If bAsk Then
        bDo = (MsgBox("Are you sure you want to start over?", vbQuestion + vbYesNo) = vbYes)
    Else
        bDo = True
    End If
    If bDo Then
        oSh.Range(oSh.Range("D2"), oSh.Range("D" & oSh.Rows.Count).End(xlUp).Offset(1)).Clear
    End If
End Sub

Module modSound

To play the sound I used some Windows API stuff. Don't worry if you don't understand this, set it and forget it!

 

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
            (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#Else
    Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" _
            (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
#End If

'Sound constants
Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10

Sub PlayBackLoop()
    If Len(Dir(ThisWorkbook.Path & "\WheelOfFortune.wav")) > 0 Then
        WAVLoop ThisWorkbook.Path & "\WheelOfFortune.wav"
    End If
End Sub

Sub PlayBackStop()
    Call WAVPlay(vbNullString)
End Sub

Sub WAVLoop(File As String)
    Dim SoundName As String
    Dim wFlags As Long
    Dim x As Long
    
    SoundName = File
    wFlags = SND_ASYNC Or SND_LOOP
    x = sndPlaySound(SoundName, wFlags)
    If x = 0 Then MsgBox "Can't play the audio file. ", vbCritical, "Error"

End Sub

Sub WAVPlay(File As String)
    Dim SoundName As String
    Dim wFlags As Long
    Dim x As Long
    
    SoundName = File
    wFlags = SND_ASYNC Or SND_NODEFAULT
    x = sndPlaySound(SoundName, wFlags)
    If x = 0 Then MsgBox "Can't play the audio file. ", vbCritical, "Error"

End Sub

The end result

Before I forget, this is the end result. The animated gif isn't as nice as the Excel file however, so make sure you download it (link at top).

Wheel Of Fortune In Excel, The end result

That's all folks!


Comments

Showing last 8 comments of 18 in total (Show All Comments):

 


Comment by: Jan Karel Pieterse (2-2-2019 16:12:29)

Hi Richard,

Sure, you can email it to me if you like.

 


Comment by: SAPPHIRE VALDEZ POLINAR (15-11-2019 16:05:00)

how to change it to names? with speeh?

 


Comment by: Jan Karel Pieterse (15-11-2019 16:11:00)

Hi

Very simple, just enter your list of names into the cells in column A of the second worksheet and then change this bit in the VBA code:


Function Add2Numbers(lValue As Long) As Boolean


to this

Function Add2Numbers(lValue As Variant) As Boolean

 


Comment by: Gian (18-2-2020 17:02:00)

Hi, I found your file really nice! but i am having an issue when i need to only select 10 players or less i encounter an issue, this file is set for 300 guests/numbers, could you please advice how can i modify the BVA code in order to have the wheel work no matter the amount of players/numbers are in the list and excluding the Zeros.

.Range("A1:B300").Sort Key1:=.Range("A1"), _
                                 Order1:=xlAscending, Header:=xlYes, _
                                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                 DataOption1:=xlSortNormal

            .Range("A1:B" & lCount + 1).Sort Key1:=.Range("B1"), _
                                             Order1:=xlAscending, Header:=xlYes, _
                                             OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                             DataOption1:=xlSortNormal
.

 


Comment by: Jan Karel Pieterse (18-2-2020 18:00:00)

Hi Gian,

I'm afraid the wheel of fortune needs at least as many numbers as I put on the visible part of the wheel (26).

 


Comment by: Gian (18-2-2020 19:39:00)

Thanks for your answer Jan, Well, I'll try something on my own but i doubt i can fix the issue ):, any way it is a great file for any one who uses it, Thank you for showing us how to do it as well!

 


Comment by: Lloyd (28-7-2020 11:24:00)

Hi, i am trying to use your wheel of fortune code for my company's lucky draw. I tried to do it using your example however, VBA keep prompting me an error saying "Sub or function not defined. Is it possible if I email you the file and help me to take a look at it?

 


Comment by: Jan Karel Pieterse (28-7-2020 11:51:00)

Hi Lloyd,

Sure, go ahead and send the file. Please refer to this message too.

 


Have a question, comment or suggestion? Then please use this form.

If your question is not directly related to this web page, but rather a more general "How do I do this" Excel question, then I advise you to ask your question here: www.eileenslounge.com.

Please enter your name (required):

Your e-mail address (optional, will only be used to inform you when your comment is published or to respond to your question directly):

Your request or comment (max 2000 characters):

To post VBA code in your comment, use [VB] tags, like this: [VB]Code goes here[/VB].

I give permission to process this data and display my name and my comment on this website accoring to our Privacy Policy.