Two weeks ago I posted a link to a workbook containing formulas calculating the shortest path in a maze. Today I have created a macro that builds a random maze.

The cell grid is 110 x 110 and the start cell is randomly chosen and colored yellow. The macro then randomly creates a path until it can´t move further. The end point is a cell with the longest distance to the start cell, colored blue.

The path between them is usually around 2500 cells. You can find the blue cell somewhere in the upper left corner, at the end of the animation. There is only one possible path between the start cell and end cell.

To start building a new maze click the button to the right of the maze, on the worksheet.

### Change animation speed

You can change the speed of this by changing this line in the macro:

If (k / 100) - Int(k / 100) = 0 Then

If you want it really slow, change it to:

If (k / 1) - Int(k / 1) = 0 Then

If you want it faster, change it to:

If (k / 200) - Int(k / 200) = 0 Then

MsgBox Tcount

before End Sub

### VBA Code

Sub BuildMaze()
Application.ScreenUpdating = False
Dim loc(0 To 110, 0 To 110)
Dim path(0 To 3)
Dim visloc() As Variant
ReDim visloc(1, 0)
Range("B2:DG111") = 1
StartR = Int(Rnd * 108) + 1
StartC = Int(Rnd * 108) + 1
Range("B2:DG111").Cells(StartR, StartC) = "S"
loc(StartR, StartC) = 1
visloc(0, 0) = StartR
visloc(1, 0) = StartC
Do
c = 0
For i = 0 To 3
path(i) = 0
Next i
If visloc(0, UBound(visloc, 2)) - 2 >= 1 Then
If loc(visloc(0, UBound(visloc, 2)) - 1, visloc(1, UBound(visloc, 2))) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) - 2, visloc(1, UBound(visloc, 2))) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) - 1, visloc(1, UBound(visloc, 2)) + 1) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) - 1, visloc(1, UBound(visloc, 2)) - 1) <> 1 Then
path(0) = 1
c = 1
End If
End If
If visloc(0, UBound(visloc, 2)) + 2 <= 110 Then
If loc(visloc(0, UBound(visloc, 2)) + 1, visloc(1, UBound(visloc, 2))) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) + 2, visloc(1, UBound(visloc, 2))) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) + 1, visloc(1, UBound(visloc, 2)) + 1) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) + 1, visloc(1, UBound(visloc, 2)) - 1) <> 1 Then
c = 1
path(1) = 1
End If
End If
If visloc(1, UBound(visloc, 2)) - 2 >= 1 Then
If loc(visloc(0, UBound(visloc, 2)), visloc(1, UBound(visloc, 2)) - 1) <> 1 And _
loc(visloc(0, UBound(visloc, 2)), visloc(1, UBound(visloc, 2)) - 2) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) + 1, visloc(1, UBound(visloc, 2)) - 1) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) - 1, visloc(1, UBound(visloc, 2)) - 1) <> 1 Then
c = 1
path(2) = 1
End If
End If
If visloc(1, UBound(visloc, 2)) + 2 <= 110 Then
If loc(visloc(0, UBound(visloc, 2)), visloc(1, UBound(visloc, 2)) + 1) <> 1 And _
loc(visloc(0, UBound(visloc, 2)), visloc(1, UBound(visloc, 2)) + 2) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) + 1, visloc(1, UBound(visloc, 2)) + 1) <> 1 And _
loc(visloc(0, UBound(visloc, 2)) - 1, visloc(1, UBound(visloc, 2)) + 1) <> 1 Then
c = 1
path(3) = 1
End If
End If
If c = 0 Then
If Ccount > Tcount Then
Tcount = Ccount
Er = visloc(0, UBound(visloc, 2))
Ec = visloc(1, UBound(visloc, 2))
End If
Ccount = Ccount - 1
ReDim Preserve visloc(UBound(visloc, 1), UBound(visloc, 2) - 1)
Else
c = 0
Do Until c <> 0
rrand = Int(Rnd * 4)
If path(rrand) = 1 Then c = rrand + 1
Loop
ReDim Preserve visloc(UBound(visloc, 1), UBound(visloc, 2) + 1)
Select Case c
Case 1
visloc(0, UBound(visloc, 2)) = visloc(0, UBound(visloc, 2) - 1) - 1
visloc(1, UBound(visloc, 2)) = visloc(1, UBound(visloc, 2) - 1)
Case 2
visloc(0, UBound(visloc, 2)) = visloc(0, UBound(visloc, 2) - 1) + 1
visloc(1, UBound(visloc, 2)) = visloc(1, UBound(visloc, 2) - 1)
Case 3
visloc(0, UBound(visloc, 2)) = visloc(0, UBound(visloc, 2) - 1)
visloc(1, UBound(visloc, 2)) = visloc(1, UBound(visloc, 2) - 1) - 1
Case 4
visloc(0, UBound(visloc, 2)) = visloc(0, UBound(visloc, 2) - 1)
visloc(1, UBound(visloc, 2)) = visloc(1, UBound(visloc, 2) - 1) + 1
End Select
Ccount = Ccount + 1
Range("B2:DG111").Cells(visloc(0, UBound(visloc, 2)), visloc(1, UBound(visloc, 2))) = ""
loc(visloc(0, UBound(visloc, 2)), visloc(1, UBound(visloc, 2))) = 1
DoEvents
End If
k = k + 1
If (k / 50) - Int(k / 50) = 0 Then
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
Loop Until visloc(0, UBound(visloc, 2)) = StartR And visloc(1, UBound(visloc, 2)) = StartC
Application.ScreenUpdating = True
Range("B2:DG111").Cells(Er, Ec) = "B"
End Sub