Neil McNiven

Data Analyst

Game of Life with Excel (VBA)

Posted on by neil

The Game of Life rules are very simple. You start with a randomly generated grid of cells (some ‘[a]live’ and some ‘dead’).What happens next is decided by the following rules:
* Any live cell with two or three live neighbours survives.
* Any dead cell with three live neighbours becomes a live cell.
* All other live cells die in the next generation. Similarly, all other dead cells stay dead.

I attempted a basic version of the Game of Life in Excel with VBA and a 30×30 grid, but it was very very slow.

My second iteration was much faster and allowed for a much larger grid as pictured below.

This was primarily achieved just by turning off screen updating while the values of the newly enlarged 100×100 cell grid was updated.

This led to my final iteration of the project…a 200×200 grid which would evolve 2-3 times per second. That is 40,000 cells being calculated and updated a couple of times every second.

The VBA code used to generate the final 200×200 iteration of the Game of Life is given below:

Sub TheGameOfLife3()
' reading in and writing out arrays to the worksheet is MUCH faster
' than reading the individual cells in a for loop etc.
Dim row As Integer
Dim column As Integer
Dim x As Integer
Dim y As Integer
Dim cellValue As Integer
Dim numNeighbours As Integer
Dim totalLifeFound As Integer

' The values in the Picture - 2d array accessed by thePicture(row,column)
Dim thePicture() As Variant
' initialise thePicture to set the size
thePicture = Worksheets("GOL-3").Range("B2:gt201").value

' Set the size of the 2d square array.
Const dimensions = 200
' Number of iterations to run for.
Const numIterations = 100

' Array to store the number of neighbours for every cell.
Dim neighboursArray(1 To dimensions, 1 To dimensions) As Integer
' Array to store the next generation of cells
Dim nextGeneration(1 To dimensions, 1 To dimensions) As Variant

' Start with calculations turned off.
Application.Calculation = xlManual


' Initialise thePicture cells with either 0 or 1 - randomly 85/15
For row = 1 To dimensions
    For column = 1 To dimensions
        randNumber = Application.WorksheetFunction.RandBetween(1, 100)
        If randNumber >= 1 And randNumber <= 15 Then
            thePicture(row, column) = 1
        Else
            thePicture(row, column) = 0
        End If
        'thePicture(row, column) = Application.WorksheetFunction.RandBetween(0, 1)
    Next column
Next row
' Display what we have generated.
Range("B2:cw101").value = thePicture


' Loop through for a certain number of iterations/generations.
For Z = 1 To numIterations

    ' THE GAME OF LIFE - take the neighbours array and decide for each cell
    ' whether it will be alive or dead in the next generation.
    totalLifeFound = 0
    For row = 1 To dimensions
        For column = 1 To dimensions
            ' Find our how many neighbours each of the cells has
            numNeighbours = hmn(row, column, thePicture, dimensions)

            ' Any live cell with two or three live neighbours survives
            ' but the rest die.
            If thePicture(row, column) = 1 Then
                If numNeighbours >= 2 And numNeighbours <= 3 Then
                    nextGeneration(row, column) = 1
                Else
                    nextGeneration(row, column) = 0
                End If
            End If

            ' Any dead cell with Exactly three live neighbours becomes a live cell
            ' but the rest stay dead.
            If thePicture(row, column) = 0 Then
                If numNeighbours = 3 Then
                    nextGeneration(row, column) = 1
                Else
                    nextGeneration(row, column) = 0
                End If
            End If

        Next column
    Next row

    ' Make thePicture equal to the just generated nextGeneration
    thePicture = nextGeneration

    ' Finally we update the display with the next generation data.
    Range("B2:gt201").value = thePicture

Next Z
End Sub
' Function to count how many neighbours surround a particular cell…with NO wrap around.
Function hmn(row As Integer, column As Integer, ByRef thePicture() As Variant, dimensions As Integer) As Integer
hmn = 0

' top left corner
y = row - 1
x = column - 1
If y <= 0 Then y = dimensions
If x <= 0 Then x = dimensions
hmn = hmn + thePicture(y, x)

' top middle
y = row - 1
x = column
If y <= 0 Then y = dimensions
hmn = hmn + thePicture(y, x)

' top right
y = row - 1
x = column + 1
If y <= 0 Then y = dimensions
If x > dimensions Then x = 1
hmn = hmn + thePicture(y, x)

' middle left
y = row
x = column - 1
If x <= 0 Then x = dimensions
hmn = hmn + thePicture(y, x)

' middle right
y = row
x = column + 1
If x > dimensions Then x = 1
hmn = hmn + thePicture(y, x)

' bottom left corner
y = row + 1
x = column - 1
If y > dimensions Then y = 1
If x <= 0 Then x = dimensions
hmn = hmn + thePicture(y, x)

' bottom middle
y = row + 1
x = column
If y > dimensions Then y = 1
hmn = hmn + thePicture(y, x)

' bottom right corner
y = row + 1
x = column + 1
If y > dimensions Then y = 1
If x > dimensions Then x = 1
hmn = hmn + thePicture(y, x)
End Function