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 -

enter image description here

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

enter image description here

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

enter image description here

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.

enter image description here

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

enter image description here

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

Here's the form and its code -

enter image description here

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

• Malachi: how do you play?
• Raystafarian: It loads up in excel - it's not standalone
• Malachi: I was having difficulty getting the forms to show up. I got it now.
• mkrieger1: I don't have the possibility to run this and I'm not familiar with this Excel/VBA stuff, so it's hard for me to tell; does the program play the game, or does it allow the user to play it?
• RubberDuck: I'm looking forward to playing/reviewing this.

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:

a shiny ActiveX 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.

• Raystafarian: I understand most of this, I'll have to do some research into using activeX, but thanks!
• Raystafarian: I'm giving this the checkmark as top answer - but all three answers helped immensely !

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)

Don't be a dinosaur

---

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.