Racetrack in... VBA?

Question

So, I took a look at the August Challenge:

The top-voted answer is Racetrack¹: "In the game of Racetrack², cars race around a track bounded by two concentric closed loops drawn on a square grid. Implement a program that plays this game."

¹_{Links to answer in meta}
²_{Links to wikipedia article of game}

and I thought, "hey, self, you should try that" - but given I only really know VBA, I did it in excel. Maybe that's not the intention of the challenge, but I did it anyway.

Experience it on github.

Note that you must have MS excel installed and macros enabled. I couldn't get it working on OSX.

---

This game is for two human players to use the form interface to move their cars around the board.

You start the game by hitting the reset button that triggers most of the code to run - you can also resume a game by activating the form

Sub Button1_Click()
    MsgBox ("This will create a new gameboard")
    Application.ScreenUpdating = False
    Range("A1:Z24").ClearContents
    Range("A1:Z24").ClearFormats
    CreateGrid
    FillOuterGrid
    FillInnerCircle
    StoreSpeed
    Application.ScreenUpdating = True
    Instruct.Show
    GameControl.Show
End Sub

The first thing to do is create the racetrack, which is semi-random each game -

Option Explicit
Sub CreateGrid()
    'Store background color in a variable so that adjusting only takes one edit
    Const BACKGROUND_COLOR As Long = vbBlack
    'In the properties of my worksheet, I gave the WS object an inherent name (like Sheet8), but called it GameBoardSheet
    With GameBoardSheet
        .Name = "GameBoard"
        Columns("B:Y").ColumnWidth = 2.14
        Columns("A").ColumnWidth = 50
        Columns("Z").ColumnWidth = 50
        Rows(1).RowHeight = 100
        Rows(24).RowHeight = 100
        Range("A1:Z1").Merge
        Range("A1").Interior.Color = BACKGROUND_COLOR
        Range("A24:Z24").Merge
        Range("A24").Interior.Color = BACKGROUND_COLOR
        Range("A2:A23").Merge
        Range("A2").Interior.Color = BACKGROUND_COLOR
        Range("Z2:Z23").Merge
        Range("z2").Interior.Color = BACKGROUND_COLOR
        Range("B2").Select
    End With
End Sub

Sub FillOuterGrid()
Dim i As Integer
Dim rngCell As Range
    For Each rngCell In Range("B2:Y2")
      i = Application.WorksheetFunction.RandBetween(0, 2)
      rngCell.Offset(i, 0).Interior.ColorIndex = 15
    Next
    For Each rngCell In Range("b23:Y23")
        i = Application.WorksheetFunction.RandBetween(-2, 0)
        rngCell.Offset(i, 0).Interior.ColorIndex = 15
    Next
    For Each rngCell In Range("B5:B20")
        i = Application.WorksheetFunction.RandBetween(0, 2)
        rngCell.Offset(0, i).Interior.ColorIndex = 15
    Next
    For Each rngCell In Range("Y5:Y20")
        i = Application.WorksheetFunction.RandBetween(-2, 0)
        rngCell.Offset(0, i).Interior.ColorIndex = 15
    Next

    For Each rngCell In Range("B4:Y4")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(-1).Interior.ColorIndex = 15
            rngCell.Offset(-2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("B3:Y3")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(-1).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("B21:Y21")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(1).Interior.ColorIndex = 15
            rngCell.Offset(2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("B22:Y22")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(1).Interior.ColorIndex = 15
        End If
    Next

    For Each rngCell In Range("D2:D23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, -1).Interior.ColorIndex = 15
            rngCell.Offset(, -2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("C2:C23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, -1).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("W2:W23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, 1).Interior.ColorIndex = 15
            rngCell.Offset(, 2).Interior.ColorIndex = 15
        End If
    Next
    For Each rngCell In Range("X2:X23")
        If rngCell.Interior.ColorIndex = 15 Then
            rngCell.Offset(, 1).Interior.ColorIndex = 15
        End If
    Next
End Sub

Sub FillInnerCircle()
Dim rngCell As Range
Dim i As Integer
Range("J11:P14").Interior.ColorIndex = 15
For Each rngCell In Range("J9:P9")
    i = Application.WorksheetFunction.RandBetween(0, 1)
    rngCell.Offset(i).Interior.ColorIndex = 15
Next
For Each rngCell In Range("J16:P16")
    i = Application.WorksheetFunction.RandBetween(-1, 0)
    rngCell.Offset(i).Interior.ColorIndex = 15
Next

For Each rngCell In Range("H11:H14")
    i = Application.WorksheetFunction.RandBetween(0, 1)
    rngCell.Offset(, i).Interior.ColorIndex = 15
Next
For Each rngCell In Range("R11:R14")
    i = Application.WorksheetFunction.RandBetween(-1, 0)
    rngCell.Offset(, i).Interior.ColorIndex = 15
Next

'fill
For Each rngCell In Range("J9:P9")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(1).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("J16:P16")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(-1).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("H11:H14")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(, 1).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("R11:R14")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(, -1).Interior.ColorIndex = 15
    End If
Next
'start and end
With Range("M17:M20").Interior
        .Pattern = xlUp
        .PatternColorIndex = xlAutomatic
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
Range("N19").Interior.ColorIndex = 3
Range("N19") = "P2"
Range("N20").Interior.ColorIndex = 8
Range("N20") = "P1"
End Sub

I'm storing my vectors and locations in cells as I really couldn't figure out a global variable to do that⁶.

 Sub StoreSpeed()
'I'm storing speed and position in cells on the sheet as I don't have a global variable for them
Range("A100") = 0
Range("A101") = 0
Range("A102") = 20
Range("A103") = 14
Range("A200") = 0
Range("A201") = 0
Range("A202") = 19
Range("A203") = 14
End Sub

Next, you'll see the instructions

When the instructions are closed, the form opens, which is how you play -

The form shows current directional speeds and current location for the player whose label is showing. The two combo boxes are used for the player to select (-1,0,1) in the right and up directions (negative slows right/up or goes left/down). Once selected, the player hits the button GO.

Now the form resets and shows the next player's stats and it's their turn to go.

If you run into a wall or the other car, it triggers a loss condition

It only triggers a win if you land on the finish line¹

Here's the form and its code -

Private Sub UserForm_Initialize()
    'Placement of Form - works well on some machines, not perfect on others
    Me.StartUpPosition = 0
    Me.Top = Application.Top + 25
    Me.Left = Application.Left + 30

    'Populate the combobox lists with an array upon initialization - this way they will always retain the values I set here
    cmbVx.List = Array("-1", "0", "1")
    cmbVy.List = Array("-1", "0", "1")

    'Player1 goes first
    LabelP1.Visible = True
    LabelP2.Visible = False
    CurrentRow.Text = Range("A102").Value
    CurrentCol.Text = Range("A103").Value
    CurrentX.Text = Range("A100").Value
    CurrentY.Text = Range("A101").Value
End Sub

And here's the code that controls the players when the GO button is clicked this is what controls gameplay -

Private Sub btnGo_Click()
On Error GoTo errHandler
Dim Vx As Integer
Vx = cmbVx.Value
Dim Vy As Integer
Vy = cmbVy.Value

Dim x As Integer
Dim y As Integer
Dim intCase As Integer
Dim MoveMe As Range

If LabelP1.Visible = True Then
    intCase = 1
    Else: intCase = 2
End If

Select Case intCase
    Case 1
    'Speed
    x = GameBoardSheet.Range("A100") + Vx
    y = GameBoardSheet.Range("A101") + Vy
    GameBoardSheet.Range("A100") = x
    GameBoardSheet.Range("A101") = y

    'Move
    With Cells(Int(CurrentRow.Value), Int(CurrentCol.Value))
        .ClearContents
        .Interior.ColorIndex = xlNone
        'Excel uses (rows,cols) notation, so Y direction is first
        'We're using (-y) so that positive 1 moves upward
        Set MoveMe = .Offset(-y, x)
    End With

            If MoveMe.Interior.ColorIndex = xlNone Then
                MoveMe = "P1"
                MoveMe.Interior.ColorIndex = 8
                Range("A102") = MoveMe.Row
                Range("A103") = MoveMe.Column
            Else: GoTo WinLose
            End If

    'set up form for next player
    LabelP1.Visible = False
    LabelP2.Visible = True
    CurrentX.Text = Range("A200")
    CurrentY.Text = Range("A201")
    CurrentRow.Text = Range("A202")
    CurrentCol.Text = Range("A203")
    Exit Sub

    'Player 2 turn
    Case 2
    'Speed
    x = GameBoardSheet.Range("A200") + Vx
    y = GameBoardSheet.Range("A201") + Vy
    GameBoardSheet.Range("A200") = x
    GameBoardSheet.Range("A201") = y

    'Move
    With Cells(Int(CurrentRow.Value), Int(CurrentCol.Value))
        .ClearContents
        .Interior.ColorIndex = xlNone
        Set MoveMe = .Offset(-y, x)
    End With

            If MoveMe.Interior.ColorIndex = xlNone Then
                MoveMe = "P2"
                MoveMe.Interior.ColorIndex = 3
                Range("A202") = MoveMe.Row
                Range("A203") = MoveMe.Column
            Else: GoTo WinLose
            End If

    'set up form for next player
    LabelP2.Visible = False
    LabelP1.Visible = True
    CurrentX.Text = Range("A100")
    CurrentY.Text = Range("A101")
    CurrentRow.Text = Range("A102")
    CurrentCol.Text = Range("A103")
    Exit Sub
    End Select

'TODO: Create function
WinLose:
    If MoveMe.Interior.ColorIndex = xlAutomatic Then
        MsgBox ("You Win!")
        MoveMe = "P1"
        MoveMe.Interior.ColorIndex = 6
    Else: MsgBox ("Whoops, you crashed!")
    End If
    Unload GameControl
    Exit Sub
'TODO: Create Function
errHandler:
    MsgBox ("Please select your values")
End Sub

Overall, it works. There are a few improvements that I think could be made that are gameplay related -

1. To win you must land on the finish line, not just cross over it. Therefor you won't trigger a win condition and could, in fact, trigger a loss if you run into a wall after crossing. The only thing I can think of us to check if a player begins in the lower-left quadrant of the board, and if so send them to a function to determine if they've won, otherwise send them back. This seems suboptimal.
2. You can "jump" over the walls as long as you end up on a valid space
3. You can cheat and go clockwise at the beginning to win (but, I mean, you're playing a game in excel)
4. With enough speed you can jump out of the game board and run all over the place. I could just check row/column don't exceed (y,x), but that seems sloppy.
5. I'm pretty sure it will error if you try to land on a cell that doesn't exist (e.g. row or column < 0)
6. I couldn't figure out how to get some Global or Public variables that would persist through the form, so speed and location information is stored in cells A100:A103 and A200:A203. Maybe this is a good thing as described by Matt's Mug

Answer 1

Implicit worksheet references

Sub CreateGrid()
    ActiveSheet.Name = "GameBoard"
    Columns("B:Y").ColumnWidth = 2.14
    Columns("A").ColumnWidth = 50
    Columns("Z").ColumnWidth = 50
    Rows(1).RowHeight = 100
    Rows(24).RowHeight = 100
    Range("A1:Z1").Merge
    Range("A1").Interior.Color = vbBlack
    Range("A24:Z24").Merge
    Range("A24").Interior.Color = vbBlack
    Range("A2:A23").Merge
    Range("A2").Interior.Color = vbBlack
    Range("Z2:Z23").Merge
    Range("z2").Interior.Color = vbBlack
    Range("B2").Select
End Sub

While only the first line in this procedure mentions ActiveSheet, every single line in this procedure is referencing Application.ActiveSheet... implicitly. And references to the active sheet are always more or less flaky.

---

Tip: By turning off Application.ScreenUpdating while you're creating the grid, you'll eliminate that "flicker", and generate the grid even faster: user won't even blink.

---

CodeName

A better approach would be to give that worksheet a meaningful programmatic name. From your screenshot I can tell you have left it to its default, Sheet8; the value of Sheet.CodeName is a "free" identifier reference - VBA creates an identifier with it, and you can use that identifier in your code.

I'd rename it to GameBoardSheet and perhaps use a With block.

Also, at one point you might want to use another background color than vbBlack, and when that happens you'd rather make the change once:

Private Sub CreateGrid()
    Const BACKGROUND_COLOR As Long = vbBlack
    With GameBoardSheet
        .Name = "GameBoard"
        .Columns("B:Y").ColumnWidth = 2.14
        .Columns("A").ColumnWidth = 50
        .Columns("Z").ColumnWidth = 50
        .Rows(1).RowHeight = 100
        .Rows(24).RowHeight = 100
        .Range("A1:Z1").Merge
        .Range("A1").Interior.Color = BACKGROUND_COLOR
        '...
    End With
End Sub

One nice thing about naming GameBoardSheet, is that you can now do away with all these:

Sheets("GameBoard")

And simply refer to that "free" GameBoardSheet reference instead.

---

How much effort would it be to refactor your code and reimplement the UI as a panel of ActiveX controls instead of a form? It seems to me that would make a more "natural" UI:

The application logic shouldn't depend on a form (let alone be completely implemented behind a form), it should be encapsulated in its own class module.

Try making a brushed-up UI by hand; freeze panes just outside the bottom-right corner of your game screen, and protect the sheet so that all the user can do is interact with the buttons: a big green "Go!" button and 4 arrow buttons that toggle between red/off and blue/on for each direction. For the user this makes a nice abstraction over the -1/0/+1 directional speed:

• If [Left] and [Right] are both the same color, X-speed is 0
• If [Up] and [Down] are both the same color, Y-speed is 0
• If [Left] is blue and [Right] is red, X-speed is 1
• If [Right] is blue and [Left] is red, X-speed is -1
• If [Up] is blue and [Down] is red, Y-speed is 1
• If [Down] is blue and [Up] is red, Y-speed is -1
• If the user doesn't toggle anything, previous turn's values are used

I'd make an ITrack interface with some Draw method:

Public Sub Draw()
End Sub

Then I could have an EasyTrack, a MediumTrack and a HardTrack, and move the FillOuterGrid and FillInnerCircle to private methods on, say, the EasyTrack class; Draw would call these two methods. Then the MediumTrack and HardTrack would draw different patterns.

You're saving the vectors on the spreadsheet itself. You know what? It's brilliant. You save the workbook, and you just saved your game! With global variables, not only you would have, well, [grabs nose] global variables... your game state would live-and-die with the program's execution, so you'd have to figure out a way to persist the vectors somewhere anyway, if you wanted to save the game state before quitting.

Answer 2

I've a few things you could improve on:

---

For Each c In Range("B2:Y2")

c seems like it could use a better name. As I found out, cells shouldn't be used other than for the system function/methods, so avoid naming it that.

---

x = Sheets("GameBoard").Range("A100")
y = Sheets("Gameboard").Range("A101")
x = x + Vx
y = y + Vy

Instead of var = var + otherVar, you can simply just use the following instead of re-assigning values:

x = Sheets("GameBoard").Range("A100") + Vx
y = Sheets("Gameboard").Range("A101") + Vy

---

With Cells(Int(curRow.Value), Int(curCol.Value))
    .ClearContents
    .Interior.ColorIndex = xlNone
     Set MoveMe = .Offset(-y, x)

Set MoveMe is indented too far, by one space

---

Else: GoTo WinLose: Don't be a dinosaur, be Chris Pratt from Jurassic World, and wrangle those dinosaurs (Use a function instead)

---

lblP2.Visible = False
lblP1.Visible = True
CurrentX.Text = Range("A100")
CurrentY.Text = Range("A101")
curRow.Text = Range("A102")
curCol.Text = Range("A103")

A few points about this:

1. Current and cur, stick to a standard throughout.
2. cur, don't sacrifice a few characters for readability: cur is bad. Current/current is better.
3. lbl: same as applies for above.

---

errHandler:
    MsgBox ("Please select your values")

Use a function here, too.

Answer 3

You have a pension for magic numbers.

   Columns("A").ColumnWidth = 50
   Columns("Z").ColumnWidth = 50
   Rows(1).RowHeight = 100
   Rows(24).RowHeight = 100

These aren't too magic, but they are repetitive. If you decide to change the border size, wouldn't it be nice to change it in just one place? Create a constant for these. However, it's not nearly as problematic as this.

For Each rngCell In Range("B21:Y21")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(1).Interior.ColorIndex = 15
        rngCell.Offset(2).Interior.ColorIndex = 15
    End If
Next
For Each rngCell In Range("B22:Y22")
    If rngCell.Interior.ColorIndex = 15 Then
        rngCell.Offset(1).Interior.ColorIndex = 15

ColorIndex = 15 shows up all over this code. While the row/column widths are easy to understand, this isn't. I have no idea what color 15 is without looking it up. This definitely needs a well named constant value, but whatever you do, don't name it something like gray. If you do, you'll have to rename if you change the value. Go with something like this.

Const TRACK_COLOR As Integer = 15 ' gray

Fun fact though. The color constants are dependent on what version of office you're running. This may render differently in Office 2003 than it will in newer versions. In fact, ColorIndex isn't even available prior to 2007. To be compatible with earlier versions, it's best to use RBG values.

It's been mentioned a little bit already, but I'd like to mention it again and challenge you to create a few classes for your game.

• Create a DAL (Data Abstraction Layer) that maps cells and ranges to more abstract concepts. In this case, a GameBoard class that will help to centralize all those calls to .Range("A100").
• Create a Game class that your user form calls instead of having that code all stuffed in the code behind. As was already pointed out, it will make it easier to swap out the UI layer later, if you choose to.