Snake in Excel in... VBA?

snake-game is a game where you control a snake in an enclosed square without running into the walls or your own body. The snake grows when you run into whatever item you are supposed to run into.

My snake eats mice:

click to watch on youtube

You can get it to play from github and hopefully it will work

To be clear, it's fully functional- just click the "begin" button or run the "DrawGameBoard" macro to begin and use your arrow keys to navigate.

Sadly, this snake runs on Worksheet_Selection_Change event. Because I need to store values after exiting the procedure, I couldn't figure out how to implement a Class.

Some other things I should mention I struggled with -

• Knowing where the end of the snake is to erase it

• Growing the snake when it eats a mouse

• Timing, of course. I think I could use a library?

• Illegal moves - you can't turn backward

• The formatting - it fits my view, but that's pretty local

• Storing the snake's path and current location to retrieve after moving, which means there are a lot of named ranges.

• VBA is not meant for this

I should also note that this snake moves in fixed vectors, meaning left is always to the player's left.

I imagine there's a lot to improve upon and I don't expect anyone to tackle the whole thing.

There are several parts of the game in the same module, but I'll break them apart here for clarity.

Sheet Module

```
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If Intersect(target, GameSheet.Range("Board")) Is Nothing Then Exit Sub
If Range("FirstMove").value > 0 Then
GameSheet.Activate
Range("FirstMove").value = 0
Application.OnTime Now + TimeValue("00:00:02"), "Start_Timing"
Exit Sub
End If
If Range("LegalMove") = 0 Then
Range("LegalMove") = 1
Exit Sub
End If

Dim storedLocation() As String
storedLocation = Split(Range("Position"), ",")
Dim currentLocation As Range
Se

VBA is totally meant for this!! One of the first programs I built in VBA was a snake game. (the following code snippets are from my game)

Here's how I handled some of the things you struggled with.

direction change. For the direction change I used the GetAsyncKeyState API

Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
Public Const KeyPressed As Integer = -32767

And in a method, one of the four direction changes.

If GetAsyncKeyState(vbKeyRight) = KeyPressed Then
        If direction = "U" Or direction = "D" Then
            direction = "R"
            DoEvents
            Exit For
        End If
    End If
    ....

End of snake, growing snake, path of snake
This is actually fairly easy, make your snake an array and only handle the upper and lower bound parts of the array. When the upper bound part of the array lands on a new cell check to see if there is an existing thing in it like a mouse, a wall, or anything else to make a decision. Ultimately change the upper bound color to say green and the lower bound color to nothing. This is how your snake will move around.

This method shows the snake movement, it's doing a few other things so take from it what you will:

```
Private Sub moveSnake() 'This is where it all happens
Dim i As Integer

'Moves the snake in the direction that the key was pressed
Select Case direction
Case "R"
ReDim Preserve snake(UB)
Set snake(UB) = snake(UB - 1).Offset(0, 1)
Case "L"
ReDim Preserve snake(UB)
Set snake(UB) = snake(UB - 1).Offset(0, -1)
Case "U"
ReDim Preserve snake(UB)
Set snake(UB) = snake(UB - 1).Offset(-1, 0)
Case "D"
ReDim Preserve snake(UB)
Set snake(UB) = snake(UB - 1).Offset(1, 0)
End Select

'End game if snake hits a wall
If snake(UB).Interior.Color = black Then
MsgBox "Splat!!! You hit a wall and died!"
gameEnd = True
Call endGame
Exit Sub
End If

'End game if snake bites its tail
For i = LB + 1 To UB - 1
If snake(UB).Interior.Color <> red Then
If snake(LB).Address = snake(i).Address Then disapearingTail = True
If snake(UB).Address = snake(i).Address Then
MsgBox "Chomp!!! You bit your tail and died"
gameEnd = True
Call endGame
End If
End If
Next

'Enable exit if all food has been eaten
If eatCount = foodCount Then
If level = 10 Then [AM80:AO80].Interior.Color = Other
If level = 8 Then [BY39:CB39].Interior.Color = white
[CB38:CB40].Interior.Color = white
[CC38] = "Exit Here"
eatCount = 0
End If

'Here's where all the action happens
Select Case snake(UB).Interior.Color
Case Is = blue
snake(UB).Interior.Color = green
UB = UB + 1
ReDim Preserve snake(UB)
Set snake(UB) = snake(UB - 1)
points = points + 10
[CC24] = points
newLength = newLength + 1
eatCount = eatCount + 1
Case Is = yellow
snake(UB).Interior.Color = green
snake(LB).Interior.Color = white
points = points + 100
[CC24] = points
UB = UB + 1
LB = LB + 1
Case Is = red
Call teleport
snake(LB).Interior.Color = white
UB = UB + 1
LB = LB + 1
Case Is = Other
If snake(LB).Interior.Color = Other Then
newLevel = True
points = points + 50
[CC24] = points
MsgBox "You Found the Secret Level!!!!", , "SECRET LEVEL"
Call secretLevel
Exit Sub
End If
Set snake(UB) = snake(UB - 1)
UB = UB - 1
ReDim Preserve snake(UB)
If snake(LB).Interior.Color <> red Then
snake(LB).Interior.Color = white
End If
eatOther = True
Case Is = grey
If snake(LB).Interior.Color = grey Then
newLevel = True
points = points + 50
[CC24] = points
MsgBox "Level " & level & "-" & subLevel & " complete!!", vbOKCancel, "Go to Next Level"
level = level + 1
If level >= 11 Then
level = 1
If subLevel = 3 And level = 10 Then MsgBox "There is a Secret Level in this Game. Look for the off color.", , "Hint"
If subLevel = 5 And level = 10 Then MsgBox "If you have not found the secret yet, look at the bottom", , "Hint"
If subLevel = 7 And level = 10 Then MsgBox "If you still haven't found it it is on the bottom of the screen" _
& "after eating all sqrs on the 10th level.", , "Hint"
subLevel = subLevel + 1
If delay <> 4 Then
delay = delay - 2
[CC24] = points
End If
End If
Call selectLevel 'Start New Level
Exit Sub
End If
Set snake(UB) = snake(UB - 1)
UB = UB - 1
ReDim Preserve snake(UB)
If

StackExchange Code Review Q#156557, answer score: 3