Simple Tic Tac Toe on excel VBA

Question

I'm trying to make a very simple Tic Tac Toe for a class I have where instead of X and O you color the cells interior blue (user) and red (macro) and no AI.

but whenever I think I got it it goes into an infinite loop

Sub Tic()

Dim r1 As Integer
Dim r2 As Integer


Do

r1 = Int(Rnd * 3) + 1
r2 = Int(Rnd * 3) + 1

If Cells(r1, r2).Interior.Color = xlNone Then   'with colorindex instead of color it fills before crashing



Cells(r1, r2).Interior.Color = vbRed


End If


Loop While Cells(r1, r2).Interior.Color = vbBlue Or Cells(r1, r2).Interior.Color <> vbRed

'tried removing the first condition but the result is the same, same with changing the second to equal


End Sub

Now Im only allowed to use the functions I'm using so I cant change too much

so what I'm thinking it should do is check if the cells are not filled with any color then it should color it red , if its blue or red then it should do nothing and look for another unfilled cell.

no matter how I look at it I just dont know what part is wrong so if you cant answer id appreciate it if someone just pointed out which part is wrong so I can focus on it

Just curious about reversing your accepted answer; is there something else you're looking for? — DeanOC, Dec 04 '14 at 22:48

score 1 · Answer 1 · answered Dec 02 '14 at 05:10

If the loop hits a blue cell, then your If statement isn't going to execute and your While condition will be met, meaning you get stuck in a loop.

Perhaps you would be better off setting a counter of the number of non-coloured cells before you enter the loop, and then decrement it each time you colour a cell. Then you can exit the loop when the counter is 0.

So if you have 9 cells, you could use

Dim r1 As Integer
Dim r2 As Integer
Dim blankCells As Integer

blankCells = 9

Do

r1 = Int(Rnd * 3) + 1
r2 = Int(Rnd * 3) + 1

If Cells(r1, r2).Interior.Color = xlNone Then   'with colorindex instead of color it fills before crashing

   blankCells = blankCells - 1

   Cells(r1, r2).Interior.Color = vbRed


End If


Loop While blankCells > 0

score 0 · Answer 2 · answered Oct 09 '20 at 06:44

my approach is a little different than yours but it's a non-userform tictactoe nonetheless :)

Play Area is E4:G6, you would need to change it manually in the code

'This is saved on the worksheet itself

Option Explicit
'Public because any "= something" operation is executed on each cell-change
'thus the value has to be defined outside the sub to not reset it each iteration,
'breaking the loop that switches between X and O
Public rCounter As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rInt As Range
    Dim rCell As Range
    Dim msg As Variant


    Dim xOffset As Integer
    Dim yOffset As Integer
    
    'This is the center cell's position
    xOffset = 5
    yOffset = 6
    
    Set rInt = Intersect(Target, Range("E4:G6"))
    If Not rInt Is Nothing Then
        For Each rCell In rInt
        If rCell.Value = "X" Or rCell.Value = "O" Then
           msg = MsgBox("You can't choose this cell!", vbOKOnly + vbInformation)
           Else
           If rCounter Mod 2 Then
           'Change these to interior.color and you have colors instead, you would 
           'need to adjust the entire code to match that though
           rCell.Value = "X"
           Else
           rCell.Value = "O"
           End If
           End If
           
        Next
    End If
    
    
    If Cells(xOffset, yOffset).Value = "X" And Cells(xOffset + 1, yOffset).Value = "X" And Cells(xOffset - 1, yOffset).Value = "X" Or Cells(xOffset, yOffset).Value = "X" And Cells(xOffset - 1, yOffset + 1).Value = "X" And Cells(xOffset + 1, yOffset - 1).Value = "X" Or Cells(xOffset, yOffset).Value = "X" And Cells(xOffset - 1, yOffset - 1).Value = "X" And Cells(xOffset + 1, yOffset + 1).Value = "X" Or Cells(xOffset, yOffset - 1).Value = "X" And Cells(xOffset - 1, yOffset - 1).Value = "X" And Cells(xOffset + 1, yOffset - 1).Value = "X" Or Cells(xOffset, yOffset + 1).Value = "X" And Cells(xOffset - 1, yOffset + 1).Value = "X" And Cells(xOffset + 1, yOffset + 1).Value = "X" Then
    msg = MsgBox("Player X wins!", vbOKOnly)
    wClearTicTacToe
    End If
    If Cells(xOffset, yOffset).Value = "O" And Cells(xOffset + 1, yOffset).Value = "O" And Cells(xOffset - 1, yOffset).Value = "O" Or Cells(xOffset, yOffset).Value = "O" And Cells(xOffset - 1, yOffset + 1).Value = "O" And Cells(xOffset + 1, yOffset - 1).Value = "O" Or Cells(xOffset, yOffset).Value = "O" And Cells(xOffset - 1, yOffset - 1).Value = "O" And Cells(xOffset + 1, yOffset + 1).Value = "O" Or Cells(xOffset, yOffset - 1).Value = "O" And Cells(xOffset - 1, yOffset - 1).Value = "O" And Cells(xOffset + 1, yOffset - 1).Value = "O" Or Cells(xOffset, yOffset + 1).Value = "O" And Cells(xOffset - 1, yOffset + 1).Value = "O" And Cells(xOffset + 1, yOffset + 1).Value = "O" Then
    msg = MsgBox("Player O wins!", vbOKOnly)
    wClearTicTacToe
    End If
    
    Set rInt = Nothing
    Set rCell = Nothing
    rCounter = rCounter + 1
End Sub

Sub wClearTicTacToe()
Range("E4:G6").Value = ""
End Sub

score 0 · Answer 3 · answered Oct 09 '20 at 07:06

The colour of an empty cell isn't xlNone, it is vbWhite.

Change this line:

If Cells(r1, r2).Interior.Color = xlNone Then

to:

If Cells(r1, r2).Interior.Color = vbWhite Then

and your code works.

Note that if Cells(r1, r2) is an existing red cell, then your code won't add a new red counter to the board.

Simple Tic Tac Toe on excel VBA

3 Answers3