How to have fun in excel? (Silly macro for your enjoyment)

[syphontwo]

EASY!

Run this little 10 minute project I did during a bit of slow time. Takes about 30 seconds to run and is fun to watch.

Sub LangtonsAnt()
    Sheets.Add
    
    'code below sets all cells to be small and square
    Application.ScreenUpdating = False
    Range(ActiveSheet.Cells.Address).RowHeight = 4
    For i = 1 To 3  'excel is needy and has to ahve this run multiple times to work, go ahead and try it only unning this block once, you will see what I mean
        With ActiveSheet
        .Columns.ColumnWidth = _
        .Columns("A").ColumnWidth / .Columns("A").Width * _
        .Rows(1).Height
        End With
    Next
    Application.ScreenUpdating = True
    
    'instructions
    MsgBox ("This is called Langton's Ant, it is an automototon with 2 rules." & Chr(13) & "  1. If the cell is white, turn it black and move to the left." & Chr(13) & "  2. If the cell is black, turn it white and move to the right." & Chr(13) & "press ctrl+pause/break to end early, but it only does 10,000 steps which should take less than 30 seconds.")
    
    'now the good stuff
    Dim x, y As Long 'x=row, y=column
    Dim direction As Single 'can only be 0-5, 1-5 correspond to cardinal directions, 0 and 5 signify passing "North" in one direction or the other
    Dim color As Boolean 'I'll get to this in a minute
    x = 30: y = 40: direction = 1 'sets arbitrary starting point and direction
    
    For i = 1 To 10000 'arbitrary numebr of steps, make it longer or shorter as you like
        Cells(x, y).Select 'I use select to give a visual representation of the "ant's" position
        
        If Selection.Interior.ColorIndex = 1 Then 'if it is black
            color = True 'note that is it black
            Selection.Interior.ColorIndex = -4142 'set it to have no fill
            direction = direction + 1 'turn right
        Else 'if it is not black
            color = False 'note it is not black
            Selection.Interior.ColorIndex = 1 'set it to black
            direction = direction - 1 'turn left
        End If
        
        If direction > 4 Then direction = 1 'if you turned right all the way back to North, set it to North
        If direction < 1 Then direction = 4 'if you turned left all the way past North, set it to West (left of north)
        
        Select Case direction
            Case 1 'going north
                x = x - 1 'minus a row
            Case 2 'going east
                y = y + 1 'add a column
            Case 3 'going south
                x = x + 1 'add a row
            Case 4 'going west
                y = y - 1 'minus a column
        End Select
    
        If x > 200 Then x = 200 'arbitrary maximum so it doesn't go off screen
        If y > 200 Then y = 200
        If x < 1 Then x = 1 'not so arbitrary minimums.  If X or Y are <1, it will error out
        If y < 1 Then y = 1 'try making them "loop" back tot he outter bounds, it will have a different behavior on hitting a boundry like that.
        DoEvents 'this is made to slow it down just ever so slightly and give you a chance to break the code if it breaks
    Next


End Sub

Some fun little practice you can do with this as a base code.

1. Change the starting position of the ant to see how it reacts with walls
2. Change the way walls interact (looping around VS hard block)
3. Add a way for the user to control the number of steps
4. Add a userform to allow a user to setup their own rules (add another rule of RED meaning don't change direction)
5. Add more ants!

PS
Sorry if you find this post inappropriate for this section, I just thought it might bring a bit of a smile and also serve to show some basic concepts. I found Langton's Ant to be a great introduction into automation.

 

[syphontwo]

Made a small mistake in the code, should ahve looped the walls, not a hard one, it had unexpected results...

Here is how to loop them:

Change

If x > 200 Then x = 200
        If y > 200 Then y = 200        If x < 1 Then x = 1
        If y < 1 Then y = 1

To

If x > 200 Then x = 1        If y > 200 Then y = 1
        If x < 1 Then x = 200
        If y < 1 Then y = 200

I also would recommend you change the 200 to 60. I like the smaller area a bit better (after further testing).

 

[Rick Rothstein]

A better place for this kind of message would be the Lounge sub-forum.

 

[syphontwo]

I would happily move it there if I could. Is there a mod I could contact to clean it up? I won't repost it there unless I am requested to. I'm not to sure the style and power of moderation available on these forums.

 

[Rick Rothstein]

I would happily move it there if I could. Is there a mod I could contact to clean it up? I won't repost it there unless I am requested to. I'm not to sure the style and power of moderation available on these forums.

After 10 minutes, you can no longer edit nor delete a message that you post. I am guessing a moderator will eventually see this and move it. I was just noting about the Lounge for any future threads like this which you might want to post.

 

[syphontwo]

Thanks for the advice. I've been wanting to find ways to give back to the community here since it has been a big help to me over the years in finding answers (most of what I needed was already asked). Best way I can think of is sharing my small programs which are either handy or fun, like this and my lexigraphic sorting function. I'll be sure to keep as much of that in the lounge as is appropriate. I sadly have very little time to browse the forums and much-less answer questions, so I give what I can.

 

[taurean]

In Excel 2016, the code seemed to trip on cell.select statement. After adding an explicit sheet reference, worked fine. Thanks for posting it.

Sub LangtonsAnt()    Dim sh As Worksheet
    Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
    'code below sets all cells to be small and square
    Application.ScreenUpdating = False
    Range(ActiveSheet.Cells.Address).RowHeight = 4
    For i = 1 To 3  'excel is needy and has to ahve this run multiple times to work, go ahead and try it only unning this block once, you will see what I mean
        With ActiveSheet
        .Columns.ColumnWidth = _
        .Columns("A").ColumnWidth / .Columns("A").Width * _
        .Rows(1).Height
        End With
    Next
    Application.ScreenUpdating = True
    
    'instructions
    MsgBox ("This is called Langton's Ant, it is an automototon with 2 rules." & Chr(13) & "  1. If the cell is white, turn it black and move to the left." & Chr(13) & "  2. If the cell is black, turn it white and move to the right." & Chr(13) & "press ctrl+pause/break to end early, but it only does 10,000 steps which should take less than 30 seconds.")
    
    'now the good stuff
    Dim x, y As Long 'x=row, y=column
    Dim direction As Single 'can only be 0-5, 1-5 correspond to cardinal directions, 0 and 5 signify passing "North" in one direction or the other
    Dim color As Boolean 'I'll get to this in a minute
    x = 30: y = 40: direction = 1 'sets arbitrary starting point and direction
    
    For i = 1 To 10000 'arbitrary numebr of steps, make it longer or shorter as you like
        sh.Cells(x, y).Select 'I use select to give a visual representation of the "ant's" position
        
        If Selection.Interior.ColorIndex = 1 Then 'if it is black
            color = True 'note that is it black
            Selection.Interior.ColorIndex = -4142 'set it to have no fill
            direction = direction + 1 'turn right
        Else 'if it is not black
            color = False 'note it is not black
            Selection.Interior.ColorIndex = 1 'set it to black
            direction = direction - 1 'turn left
        End If
        
        If direction > 4 Then direction = 1 'if you turned right all the way back to North, set it to North
        If direction < 1 Then direction = 4 'if you turned left all the way past North, set it to West (left of north)
        
        Select Case direction
            Case 1 'going north
                x = x - 1 'minus a row
            Case 2 'going east
                y = y + 1 'add a column
            Case 3 'going south
                x = x + 1 'add a row
            Case 4 'going west
                y = y - 1 'minus a column
        End Select
    
        If x > 200 Then x = 1:        If y > 200 Then y = 1
        If x < 1 Then x = 200
        If y < 1 Then y = 200 'try making them "loop" back tot he outter bounds, it will have a different behavior on hitting a boundry like that.
        DoEvents 'this is made to slow it down just ever so slightly and give you a chance to break the code if it breaks
    Next




End Sub

 

[syphontwo]

Glad you found it agreeable. I would never normally use a select statement, but I find that it makes the macro more visually appealing rather than having the white and black just changing randomly. Its hard enough to try and follow the pattern as it is.

 

[Krayons]

@syphontwo

This is pretty neat mate! Nice work