The Execution (preferably of my code not of me)

Since the main audience for this will be people interested in programming, I think it is about time that I uploaded my code!


Sub antmenu()
'This is the code for the menu. It loops until a valid command is entered, in which case it runs that program then returns to the menu.
Dim mode, menucounter As String


menucounter = 0


Do While menucounter = 0


    mode = InputBox("Which program would you like to run?")


    Select Case mode
        Case Is = "demo"
            demo
        Case Is = "advanced"
            advanced
        Case Is = "clear"
            clear
        Case Is = "exit"
            menucounter = 1
        Case Else
            MsgBox ("Invalid option")
    End Select
Loop


End Sub


Sub demo()


Dim xa, xb, ya, yb, directiona, directionb, coloura, colourb, turn, offsetx, offsety As Long


xa = 8192
ya = 524288
turn = 1
offsetx = 100
offsety = 100
directiona = 4
directionb = 2
xb = xa + offsetx
yb = ya + offsety


Do Until turn = 50000
    
    coloura = Cells(ya, xa).Interior.ColorIndex
    If coloura = -4142 Then
        directiona = directiona + 1
        Cells(ya, xa).Interior.ColorIndex = 3
    ElseIf coloura = 1 Or 29 Or 5 Or 3 Or 12 Then
        directiona = directiona - 1
        Cells(ya, xa).Interior.ColorIndex = -4142
    End If
    
    If directiona = 0 Then directiona = 4
    If directiona = 5 Then directiona = 1
    
    Select Case directiona
        Case Is = 1
            ya = ya - 1
        Case Is = 2
            xa = xa + 1
        Case Is = 3
            ya = ya + 1
        Case Is = 4
            xa = xa - 1
    End Select


    colourb = Cells(yb, xb).Interior.ColorIndex
    If colourb = -4142 Then
        directionb = directionb + 1
        Cells(yb, xb).Interior.ColorIndex = 12
    ElseIf colourb = 1 Or 29 Or 5 Or 3 Or 12 Then
        directionb = directionb - 1
        Cells(yb, xb).Interior.ColorIndex = -4142
    End If
    
    If directionb = 0 Then directionb = 4
    If directionb = 5 Then directionb = 1
    
    Select Case directionb
        Case Is = 1
            yb = yb - 1
        Case Is = 2
            xb = xb + 1
        Case Is = 3
            yb = yb + 1
        Case Is = 4
            xb = xb - 1
    End Select


    turn = turn + 1


Loop


End Sub


Sub clear()
Range("A1:XFD1048576").Interior.ColorIndex = -4142
Range("A1:XFD1048576") = ""
End Sub




Sub advanced()


'Asks the user the number of ants they want.
Dim n As Integer
n = 55
Do Until n < 55
    n = InputBox("How many ants would you like?")
    n = n - 1
Loop


'Creates the arrays, x and y are the coordinates and currentcolour the colour of the cell the ant is in. Colour is the colour and direction is the direction of the ant, and turn is fairly obvious.
Dim x() As Long, y() As Long, direction() As Long, currentcolour() As Long, colour() As Long, turn As Long
ReDim x(0 To n) As Long
ReDim y(0 To n) As Long
ReDim direction(0 To n) As Long
ReDim currentcolour(0 To n) As Long
ReDim colour(0 To n) As Long


'Sets up the intial positions of the ants, randomly placing them around a 200 cell square.
x(0) = 8192
y(0) = 524288
direction(0) = 1
colour(0) = 3
turn = 1
Dim counterinitialpositions As Integer
counterinitialpositions = 1
Do Until counterinitialpositions = n + 1
    x(counterinitialpositions) = x(0) + Int((201) * Rnd - 100)
    y(counterinitialpositions) = y(0) + Int((201) * Rnd - 100)
    direction(counterinitialpositions) = Int((4 - 1) * Rnd - 1)
    colour(counterinitialpositions) = 3 + counterinitialpositions
    counterinitialpositions = counterinitialpositions + 1
Loop


Dim counterruntime As Integer


Do Until turn = 50000
    counterruntime = 0
    Do Until counterruntime = n + 1
        
        'Changes the colour of the cell and direction of the ant.
        currentcolour(counterruntime) = Cells(y(counterruntime), x(counterruntime)).Interior.ColorIndex
        If currentcolour(counterruntime) = -4142 Then
            direction(counterruntime) = direction(counterruntime) + 1
            Cells(y(counterruntime), x(counterruntime)).Interior.ColorIndex = colour(counterruntime)
        Else
            direction(counterruntime) = direction(counterruntime) - 1
            Cells(y(counterruntime), x(counterruntime)).Interior.ColorIndex = -4142
        End If
        
        'Keeps the direction modulus 4.
        If direction(counterruntime) = 0 Then direction(counterruntime) = 4
        If direction(counterruntime) = 5 Then direction(counterruntime) = 1
        
        'Moves the ant.
        Select Case direction(counterruntime)
            Case Is = 1
                y(counterruntime) = y(counterruntime) - 1
            Case Is = 2
                x(counterruntime) = x(counterruntime) + 1
            Case Is = 3
                y(counterruntime) = y(counterruntime) + 1
            Case Is = 4
                x(counterruntime) = x(counterruntime) - 1
        End Select
        
        counterruntime = counterruntime + 1
    Loop
    turn = turn + 1
Loop
End Sub

The code is in green and the comments are in red (comments are just notes that describe what the following section of code does). I decided not to waste time making the demo readable, if you read through the advanced code you should be able to see fairly easily what the demo is up to.

If you want to try this code out for yourself then you will need to do the following:

1. Open up Excel (hopefully you are using 2007/10, if not then just comment and I will give you help), go to the 'view' tab and click on 'macro' on the far right.
2. Click 'create' in the small window that opens, then copy and paste the code into the new window.
3. Close both new windows, then Ctrl+E will bring up the menu. 
4. The four commands are 
1. "basic" - Runs two Langton's Ants in the same starting pattern as in my first post.
2. "advanced" - Runs n ants, randomly distributing them around a 200 cell square.
3. "clear" - Returns every cell to its default white.
4. "exit" - Closes the menu.

No updates on the code today, but I am going out to the pub during the day tomorrow leaving all evening for some drunken antics (I apologise, I really couldn't help myself).

211,

mathmo