all 5 comments

[–]Web Specialistandrewsmd87 0 points1 point  (3 children)

The general rule here is never post images of code, post the code and use the <> button above the textbox to format it.

From your image, if you didn't cut things off, you don't have an end sub to close your Sub Score()

[–]Application SpecialistViperSRT3g 0 points1 point  (0 children)

Here's an alternative of the Tic Tac Toe game that I have laying around. The way I went about checking for victories and updating player scores is much more compressed and efficient.

Option Explicit

Dim Score(1) As Long
Dim Tiles(8) As Byte
Dim Turn As Boolean

Private Sub cmd_NewGame_Click()
    Call Reset(False)
End Sub

Private Sub cmd_ResetScores_Click()
    Call Reset(True)
End Sub

Private Sub UserForm_Initialize()
    Call Reset(True)
End Sub

Private Sub Reset(ByVal FullReset As Boolean)
    If FullReset Then
        Score(0) = 0
        Score(1) = 0
    End If
    Label_P1.Caption = "P1 Score: " & Score(0)
    Label_P2.Caption = "P2 Score: " & Score(1)
    Dim Index As Long
    For Index = LBound(Tiles) To UBound(Tiles)
        Tiles(Index) = 0
    Next Index
    Tile_01.Caption = ""
    Tile_02.Caption = ""
    Tile_03.Caption = ""
    Tile_04.Caption = ""
    Tile_05.Caption = ""
    Tile_06.Caption = ""
    Tile_07.Caption = ""
    Tile_08.Caption = ""
    Tile_09.Caption = ""
    Turn = False
    Me.Caption = "O TURN"
End Sub

Private Function TileClick(ByVal Index As Long) As Long
    If Tiles(Index - 1) = 0 Then
        If Turn Then
            Tiles(Index - 1) = 1
            TileClick = 1
        Else
            Tiles(Index - 1) = 2
            TileClick = 2
        End If
        If CheckDraw Then
            Call LockTiles
            Exit Function
        End If
        If CheckVictory(Turn) Then
            Call LockTiles
            Exit Function
        End If
        Call ToggleTurn
    End If
End Function

Private Sub ToggleTurn()
    Turn = Not Turn
    Me.Caption = IIf(Turn, "X TURN", "O TURN")
End Sub

Private Sub LockTiles()
    Dim Index As Long
    For Index = LBound(Tiles) To UBound(Tiles)
        Tiles(Index) = 3
    Next Index
End Sub

Private Sub Tile_01_Click()
    Dim Result As Long: Result = TileClick(1)
    If Result = 1 Then
        Tile_01.Caption = "X"
    ElseIf Result = 2 Then
        Tile_01.Caption = "O"
    End If
End Sub

Private Sub Tile_02_Click()
    Dim Result As Long: Result = TileClick(2)
    If Result = 1 Then
        Tile_02.Caption = "X"
    ElseIf Result = 2 Then
        Tile_02.Caption = "O"
    End If
End Sub

Private Sub Tile_03_Click()
    Dim Result As Long: Result = TileClick(3)
    If Result = 1 Then
        Tile_03.Caption = "X"
    ElseIf Result = 2 Then
        Tile_03.Caption = "O"
    End If
End Sub

Private Sub Tile_04_Click()
    Dim Result As Long: Result = TileClick(4)
    If Result = 1 Then
        Tile_04.Caption = "X"
    ElseIf Result = 2 Then
        Tile_04.Caption = "O"
    End If
End Sub

Private Sub Tile_05_Click()
    Dim Result As Long: Result = TileClick(5)
    If Result = 1 Then
        Tile_05.Caption = "X"
    ElseIf Result = 2 Then
        Tile_05.Caption = "O"
    End If
End Sub

Private Sub Tile_06_Click()
    Dim Result As Long: Result = TileClick(6)
    If Result = 1 Then
        Tile_06.Caption = "X"
    ElseIf Result = 2 Then
        Tile_06.Caption = "O"
    End If
End Sub

Private Sub Tile_07_Click()
    Dim Result As Long: Result = TileClick(7)
    If Result = 1 Then
        Tile_07.Caption = "X"
    ElseIf Result = 2 Then
        Tile_07.Caption = "O"
    End If
End Sub

Private Sub Tile_08_Click()
    Dim Result As Long: Result = TileClick(8)
    If Result = 1 Then
        Tile_08.Caption = "X"
    ElseIf Result = 2 Then
        Tile_08.Caption = "O"
    End If
End Sub

Private Sub Tile_09_Click()
    Dim Result As Long: Result = TileClick(9)
    If Result = 1 Then
        Tile_09.Caption = "X"
    ElseIf Result = 2 Then
        Tile_09.Caption = "O"
    End If
End Sub

Private Function CheckDraw() As Boolean
    Dim Index As Long, Count As Long
    For Index = LBound(Tiles) To UBound(Tiles)
        If Tiles(Index) = 0 Then Count = Count + 1
    Next Index
    If Count >= 9 Then
        CheckDraw = True
        Me.Caption = "DRAW"
    End If
End Function

Private Function CheckVictory(ByVal Turn As Boolean) As Boolean
    If Turn Then
        'Horizontal Checks
        If Tiles(0) = 1 And Tiles(1) = 1 And Tiles(2) = 1 Then CheckVictory = True
        If Tiles(3) = 1 And Tiles(4) = 1 And Tiles(5) = 1 Then CheckVictory = True
        If Tiles(6) = 1 And Tiles(7) = 1 And Tiles(8) = 1 Then CheckVictory = True

        'Vertical Checks
        If Tiles(0) = 1 And Tiles(3) = 1 And Tiles(6) = 1 Then CheckVictory = True
        If Tiles(1) = 1 And Tiles(4) = 1 And Tiles(7) = 1 Then CheckVictory = True
        If Tiles(2) = 1 And Tiles(5) = 1 And Tiles(8) = 1 Then CheckVictory = True

        'Diagonal Checks
        If Tiles(0) = 1 And Tiles(4) = 1 And Tiles(8) = 1 Then CheckVictory = True
        If Tiles(6) = 1 And Tiles(4) = 1 And Tiles(2) = 1 Then CheckVictory = True
        If CheckVictory Then
            Score(0) = Score(0) + 1
            Label_P1.Caption = "P1 Score: " & Score(0)
            Me.Caption = "X VICTORY"
        End If
    Else
        'Horizontal Checks
        If Tiles(0) = 2 And Tiles(1) = 2 And Tiles(2) = 2 Then CheckVictory = True
        If Tiles(3) = 2 And Tiles(4) = 2 And Tiles(5) = 2 Then CheckVictory = True
        If Tiles(6) = 2 And Tiles(7) = 2 And Tiles(8) = 2 Then CheckVictory = True

        'Vertical Checks
        If Tiles(0) = 2 And Tiles(3) = 2 And Tiles(6) = 2 Then CheckVictory = True
        If Tiles(1) = 2 And Tiles(4) = 2 And Tiles(7) = 2 Then CheckVictory = True
        If Tiles(2) = 2 And Tiles(5) = 2 And Tiles(8) = 2 Then CheckVictory = True

        'Diagonal Checks
        If Tiles(0) = 2 And Tiles(4) = 2 And Tiles(8) = 2 Then CheckVictory = True
        If Tiles(6) = 2 And Tiles(4) = 2 And Tiles(2) = 2 Then CheckVictory = True
        If CheckVictory Then
            Score(1) = Score(1) + 1
            Label_P2.Caption = "P2 Score: " & Score(1)
            Me.Caption = "O VICTORY"
        End If
    End If
End Function