PDA

View Full Version : Sleeper: TicTacToe Smarts



Dave
06-12-2005, 11:01 PM
I've been thinking about how to create a sort of XL smarts that would be able to tie & beat a player +50% in a game of TicTacToe. I'm sure from a philisophical point of view this may have crushing implications...a quasi intelligence sort of blows away I think, therefore I am. :cloud9: It seems to me I need to create a few UDF's in order for this to happen... so if it's raining and you enjoy brain dead games and/or quasi productive undertakings, I encourage you to join in and make the best UDF to outsmart yourself. The following code placed in a module plays the game when you call Makeform... and yes I know it ain't pretty. It currently randomly generates the computer's play. My plan which I'am very flexible with is as follows:
'on computer move:
'randomly select number and place if it meets conditions:
'starting or tieing move(Tie:1 or 9) ie. exit
'UDFWinit: check for 2 computer X/O's together or spaced apart
'UDFBlockit: check for 2 player O/X's together or spaced apart
'UDFStrategy: place computer X/O beside another X/O
'else: randomly select another number
'loop until X placed
I'm also quite sure had I hit the search button enough times I wouldn't be looking for a solution but then I wouldn't have learned anything. So... If anyone cares to contribute please do. Dave



Option Base 1
Public Uf
Dim ttt(3, 3) As Variant
Dim cletter As String, pletter As String

Public Sub Tictactoe()
'Plays tictactoe in range A1:C3
Dim cttt(9) As Variant, tie As Integer, tiecnt As Integer
Dim ccnt As Integer, ycnt As Integer
tiecnt = 0
ccnt = 0
ycnt = 0
above:
'clear play area & wait for Uf Tb focus change(s)
Sheets("sheet1").Range("a1:c3").Clear
Application.Wait (Now + TimeValue("0:00:01"))
tie = 0
tryagain:
pletter = Application.InputBox _
("Use capital letter entry. Enter your choice : X or O")
If pletter = "X" Or pletter = "O" Then
If pletter = "X" Then
cletter = "O"
Else
cletter = "X"
End If
Else
MsgBox "Capital X or O"
GoTo tryagain
End If
Randomize
starter = Int((2 * Rnd) + 1)
If starter = 1 Then
MsgBox "I'll start"
Else
MsgBox "You start"
tie = tie + 1
loadarray
yourwin
End If
Do
makemove
If checkwin Then
ccnt = ccnt + 1
MsgBox "I win. The score is: " & ccnt & " wins for me, " & ycnt & " wins for you and " & tiecnt & " ties"
Exit Do
Else
tie = tie + 1
If tie = 9 Then
tiecnt = tiecnt + 1
MsgBox "It's a tie. The score is: " & ccnt & " wins for me, " & ycnt & " wins for you and " & tiecnt & " ties"
Exit Do
End If
loadarray
If yourwin Then
ycnt = ycnt + 1
MsgBox "You win. The score is: " & ccnt & " wins for me, " & ycnt & " wins for you and " & tiecnt & " ties"
Exit Do
End If
End If
tie = tie + 1
If tie = 9 Then
tiecnt = tiecnt + 1
MsgBox "It's a tie. The score is: " & ccnt & " wins for me, " & ycnt & " wins for you and " & tiecnt & " ties"
Exit Do
End If
Loop
If MsgBox(prompt:="Do you want to play again?", Buttons:=vbYesNo, Title:="PLAY AGAIN") = vbYes Then
GoTo above
End If
'Remove the VBcomponent
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=Uf
End Sub

Function yourwin() As Boolean
'players turn
Dim WsShell
Dim intText As Integer
yourwin = False
before:
waittime
If anychange Then
If checkwin Then
yourwin = True
Exit Function
End If
Else
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("IT'S YOUR TURN!", 2, "HURRY UP!")
Set WsShell = Nothing
'MsgBox "Hurry up! It's your turn"
GoTo before
End If
End Function

Function makemove()
'randomly generate computer move
Dim Xoplace As Integer
Randomize
Do
Xoplace = Int((9 * Rnd) + 1)
If Xoplace = 1 And [sheet1!a1] = vbNullString Then
[sheet1!a1] = cletter
Exit Do
End If
If Xoplace = 2 And [sheet1!a2] = vbNullString Then
[sheet1!a2] = cletter
Exit Do
End If
If Xoplace = 3 And [sheet1!a3] = vbNullString Then
[sheet1!a3] = cletter
Exit Do
End If
If Xoplace = 4 And [sheet1!b1] = vbNullString Then
[sheet1!b1] = cletter
Exit Do
End If
If Xoplace = 5 And [sheet1!b2] = vbNullString Then
[sheet1!b2] = cletter
Exit Do
End If
If Xoplace = 6 And [sheet1!b3] = vbNullString Then
[sheet1!b3] = cletter
Exit Do
End If
If Xoplace = 7 And [sheet1!c1] = vbNullString Then
[sheet1!c1] = cletter
Exit Do
End If
If Xoplace = 8 And [sheet1!c2] = vbNullString Then
[sheet1!c2] = cletter
Exit Do
End If
If Xoplace = 9 And [sheet1!c3] = vbNullString Then
[sheet1!c3] = cletter
Exit Do
End If
Loop
End Function

Function checkwin() As Boolean
'check for win
If [sheet1!a1] = "X" And [sheet1!b1] = "X" And [sheet1!c1] = "X" Then
checkwin = True
End If
If [sheet1!a2] = "X" And [sheet1!b2] = "X" And [sheet1!c2] = "X" Then
checkwin = True
End If
If [sheet1!a3] = "X" And [sheet1!b3] = "X" And [sheet1!c3] = "X" Then
checkwin = True
End If
If [sheet1!a1] = "X" And [sheet1!b2] = "X" And [sheet1!c3] = "X" Then
checkwin = True
End If
If [sheet1!a3] = "X" And [sheet1!b2] = "X" And [sheet1!c1] = "X" Then
checkwin = True
End If
If [sheet1!a1] = "X" And [sheet1!a2] = "X" And [sheet1!a3] = "X" Then
checkwin = True
End If
If [sheet1!b1] = "X" And [sheet1!b2] = "X" And [sheet1!b3] = "X" Then
checkwin = True
End If
If [sheet1!c1] = "X" And [sheet1!c2] = "X" And [sheet1!c3] = "X" Then
checkwin = True
End If
If [sheet1!a1] = "O" And [sheet1!b1] = "O" And [sheet1!c1] = "O" Then
checkwin = True
End If
If [sheet1!a2] = "O" And [sheet1!b2] = "O" And [sheet1!c2] = "O" Then
checkwin = True
End If
If [sheet1!a3] = "O" And [sheet1!b3] = "O" And [sheet1!c3] = "O" Then
checkwin = True
End If
If [sheet1!a1] = "O" And [sheet1!b2] = "O" And [sheet1!c3] = "O" Then
checkwin = True
End If
If [sheet1!a3] = "O" And [sheet1!b2] = "O" And [sheet1!c1] = "O" Then
checkwin = True
End If
If [sheet1!a1] = "O" And [sheet1!a2] = "O" And [sheet1!a3] = "O" Then
checkwin = True
End If
If [sheet1!b1] = "O" And [sheet1!b2] = "O" And [sheet1!b3] = "O" Then
checkwin = True
End If
If [sheet1!c1] = "O" And [sheet1!c2] = "O" And [sheet1!c3] = "O" Then
checkwin = True
End If
End Function

Function loadarray()
'load array
For cnt1 = 1 To 3
For cnt2 = 1 To 3
ttt(cnt1, cnt2) = Cells(cnt1, cnt2)
Next cnt2
Next cnt1
End Function

Function anychange() As Boolean
'compare A1:C3 to previous stored in array(ttt)
anychange = False
For cnt1 = 1 To 3
For cnt2 = 1 To 3
If ttt(cnt1, cnt2) <> Cells(cnt1, cnt2) Then
If Cells(cnt1, cnt2) <> "X" And Cells(cnt1, cnt2) <> "O" Then
MsgBox "This is X or O's. Try again"
Cells(cnt1, cnt2) = vbNullString
Exit Function
End If
If Cells(cnt1, cnt2) <> pletter Then
MsgBox "You are: " & pletter & " Try again"
Cells(cnt1, cnt2) = vbNullString
Exit Function
End If
anychange = True
End If
Next cnt2
Next cnt1
End Function
Function waittime()
Dim PauseTime, Start
PauseTime = 5 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
End Function

Public Sub makeform()
'Add temporary Userform
Set Uf = ThisWorkbook.VBProject.VBComponents.Add(3)
'add textboxes
Set Tb1 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox1")
With Tb1
.Left = 30
.Top = 30
.Width = 54.25
.Height = 15.75
.ControlSource = "a1"
End With
Set Tb2 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox2")
With Tb2
.Left = 30
.Top = 70
.Width = 54.25
.Height = 15.75
.ControlSource = "a2"
End With
Set Tb3 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox3")
With Tb3
.Left = 30
.Top = 110
.Width = 54.25
.Height = 15.75
.ControlSource = "a3"
End With
Set Tb4 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox4")
With Tb4
.Left = 100
.Top = 30
.Width = 54.25
.Height = 15.75
.ControlSource = "b1"
End With
Set Tb5 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox5")
With Tb5
.Left = 100
.Top = 70
.Width = 54.25
.Height = 15.75
.ControlSource = "b2"
End With
Set Tb6 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox6")
With Tb6
.Left = 100
.Top = 110
.Width = 54.25
.Height = 15.75
.ControlSource = "b3"
End With
Set Tb7 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox7")
With Tb7
.Left = 170
.Top = 30
.Width = 54.25
.Height = 15.75
.ControlSource = "c1"
End With
Set Tb8 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox8")
With Tb8
.Left = 170
.Top = 70
.Width = 54.25
.Height = 15.75
.ControlSource = "c2"
End With
Set Tb9 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox9")
With Tb9
.Left = 170
.Top = 110
.Width = 54.25
.Height = 15.75
.ControlSource = "c3"
End With
With Uf.CodeModule
'cancel userform close with "X"
.insertlines 1, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
.insertlines 2, "If CloseMode = vbformcontrolmenu Then Cancel = True"
.insertlines 3, "End Sub"
.insertlines 4, "Private Sub UserForm_Activate()"
.insertlines 5, "call tictactoe"
.insertlines 6, "end sub"
.insertlines 7, "Private Sub TextBox1_Change()"
.insertlines 8, "Textbox5.SetFocus"
.insertlines 9, "End Sub"
.insertlines 10, "Private Sub TextBox2_Change()"
.insertlines 11, "TextBox5.SetFocus"
.insertlines 12, "End Sub"
.insertlines 13, "Private Sub TextBox3_Change()"
.insertlines 14, "TextBox5.SetFocus"
.insertlines 15, "End Sub"
.insertlines 16, "Private Sub TextBox4_Change()"
.insertlines 17, "TextBox5.SetFocus"
.insertlines 18, "End Sub"
.insertlines 19, "Private Sub TextBox5_Change()"
.insertlines 20, "TextBox6.SetFocus"
.insertlines 21, "End Sub"
.insertlines 22, "Private Sub TextBox6_Change()"
.insertlines 23, "TextBox5.SetFocus"
.insertlines 24, "End Sub"
.insertlines 25, "Private Sub TextBox7_Change()"
.insertlines 26, "TextBox5.SetFocus"
.insertlines 27, "End Sub"
.insertlines 28, "Private Sub TextBox8_Change()"
.insertlines 29, "TextBox5.SetFocus"
.insertlines 30, "End Sub"
.insertlines 31, "Private Sub TextBox9_Change()"
.insertlines 32, "TextBox5.SetFocus"
.insertlines 33, "End Sub"
End With
'Properties for the userform
With Uf
.Properties("Caption") = "TicTacToe Enter X or O"
.Properties("Width") = 250
.Properties("Height") = 200
End With
'Include the UF in the Userforms collection
Set vuf = VBA.UserForms.Add(Uf.Name)
'Show the Userform
vuf.Show
End Sub


Edit: I don't know how to adjust the code to fix the screen resolution ... whoops on the post but if someone can fix that please do

Dave
06-14-2005, 11:00 AM
Rain, rain, rain... It seems like this wasn't as hard as I had imagined. Just needed to add UDFWinit with a few other minor changes. Now out of 10 games the computer won 4, I won 3 and there were 3 ties. If you have a few minutes and want to try it out I'd like to know your score. Dave
ps. as before place the following code in a module and call makeform



Option Base 1
Public Uf
Dim ttt(3, 3) As Variant, Tie As Integer
Dim cletter As String, pletter As String
Public Sub Tictactoe()
'Plays tictactoe in range A1:C3
Dim cttt(9) As Variant, tiecnt As Integer
Dim ccnt As Integer, ycnt As Integer
tiecnt = 0
ccnt = 0
ycnt = 0
above:
'clear play area & wait for Uf Tb focus change(s)
Sheets("sheet1").Range("a1:c3").Clear
Application.Wait (Now + TimeValue("0:00:01"))
Tie = 0
tryagain:
pletter = Application.InputBox _
("Use capital letter entry. Enter your choice : X or O")
If pletter = "X" Or pletter = "O" Then
If pletter = "X" Then
cletter = "O"
Else
cletter = "X"
End If
Else
MsgBox "Capital X or O"
GoTo tryagain
End If
Randomize
starter = Int((2 * Rnd) + 1)
If starter = 1 Then
MsgBox "I'll start"
Else
MsgBox "You start"
Tie = Tie + 1
loadarray
yourwin
End If
Do
makemove
If checkwin Then
ccnt = ccnt + 1
MsgBox "I win. The score is: " & ccnt & " wins for me, " & ycnt & _
" wins for you and " & tiecnt & " ties"
Exit Do
Else
Tie = Tie + 1
If Tie = 9 Then
tiecnt = tiecnt + 1
MsgBox "It's a tie. The score is: " & ccnt & " wins for me, " & ycnt & _
" wins for you and " & tiecnt & " ties"
Exit Do
End If
loadarray
If yourwin Then
ycnt = ycnt + 1
MsgBox "You win. The score is: " & ccnt & " wins for me, " & ycnt & _
" wins for you and " & tiecnt & " ties"
Exit Do
End If
End If
Tie = Tie + 1
If Tie = 9 Then
tiecnt = tiecnt + 1
MsgBox "It's a tie. The score is: " & ccnt & " wins for me, " & ycnt & _
" wins for you and " & tiecnt & " ties"
Exit Do
End If
Loop
If MsgBox(prompt:="Do you want to play again?", Buttons:=vbYesNo, Title:="PLAY AGAIN") _
= vbYes Then
GoTo above
End If
'Remove the VBcomponent
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=Uf
End Sub

Function yourwin() As Boolean
'players turn
Dim WsShell
Dim intText As Integer
yourwin = False
before:
waittime
If anychange Then
If checkwin Then
yourwin = True
Exit Function
End If
Else
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("IT'S YOUR TURN!", 2, "HURRY UP!")
Set WsShell = Nothing
GoTo before
End If
End Function

Function makemove()
'randomly generate computer turn
Dim Xoplace As Integer, Loopcnt As Integer
Randomize
Do
Loopcnt = Loopcnt + 1
Xoplace = Int((9 * Rnd) + 1)
If Tie < 3 Or Tie = 8 Or Loopcnt > 100 Then
If Xoplace = 1 And [sheet1!a1] = vbNullString Then
[sheet1!a1] = cletter
Exit Do
End If
If Xoplace = 2 And [sheet1!a2] = vbNullString Then
[sheet1!a2] = cletter
Exit Do
End If
If Xoplace = 3 And [sheet1!a3] = vbNullString Then
[sheet1!a3] = cletter
Exit Do
End If
If Xoplace = 4 And [sheet1!b1] = vbNullString Then
[sheet1!b1] = cletter
Exit Do
End If
If Xoplace = 5 And [sheet1!b2] = vbNullString Then
[sheet1!b2] = cletter
Exit Do
End If
If Xoplace = 6 And [sheet1!b3] = vbNullString Then
[sheet1!b3] = cletter
Exit Do
End If
If Xoplace = 7 And [sheet1!c1] = vbNullString Then
[sheet1!c1] = cletter
Exit Do
End If
If Xoplace = 8 And [sheet1!c2] = vbNullString Then
[sheet1!c2] = cletter
Exit Do
End If
If Xoplace = 9 And [sheet1!c3] = vbNullString Then
[sheet1!c3] = cletter
Exit Do
End If
Else
If Loopcnt < 50 Then
If UDFWinit(Xoplace, cletter) Then
Exit Do
End If
Else
If UDFWinit(Xoplace, pletter) Then
Exit Do
End If
End If
End If
Loop
End Function

Function checkwin() As Boolean
'check for win
If [sheet1!a1] = "X" And [sheet1!b1] = "X" And [sheet1!c1] = "X" Then
checkwin = True
End If
If [sheet1!a2] = "X" And [sheet1!b2] = "X" And [sheet1!c2] = "X" Then
checkwin = True
End If
If [sheet1!a3] = "X" And [sheet1!b3] = "X" And [sheet1!c3] = "X" Then
checkwin = True
End If
If [sheet1!a1] = "X" And [sheet1!b2] = "X" And [sheet1!c3] = "X" Then
checkwin = True
End If
If [sheet1!a3] = "X" And [sheet1!b2] = "X" And [sheet1!c1] = "X" Then
checkwin = True
End If
If [sheet1!a1] = "X" And [sheet1!a2] = "X" And [sheet1!a3] = "X" Then
checkwin = True
End If
If [sheet1!b1] = "X" And [sheet1!b2] = "X" And [sheet1!b3] = "X" Then
checkwin = True
End If
If [sheet1!c1] = "X" And [sheet1!c2] = "X" And [sheet1!c3] = "X" Then
checkwin = True
End If
If [sheet1!a1] = "O" And [sheet1!b1] = "O" And [sheet1!c1] = "O" Then
checkwin = True
End If
If [sheet1!a2] = "O" And [sheet1!b2] = "O" And [sheet1!c2] = "O" Then
checkwin = True
End If
If [sheet1!a3] = "O" And [sheet1!b3] = "O" And [sheet1!c3] = "O" Then
checkwin = True
End If
If [sheet1!a1] = "O" And [sheet1!b2] = "O" And [sheet1!c3] = "O" Then
checkwin = True
End If
If [sheet1!a3] = "O" And [sheet1!b2] = "O" And [sheet1!c1] = "O" Then
checkwin = True
End If
If [sheet1!a1] = "O" And [sheet1!a2] = "O" And [sheet1!a3] = "O" Then
checkwin = True
End If
If [sheet1!b1] = "O" And [sheet1!b2] = "O" And [sheet1!b3] = "O" Then
checkwin = True
End If
If [sheet1!c1] = "O" And [sheet1!c2] = "O" And [sheet1!c3] = "O" Then
checkwin = True
End If
End Function

Function loadarray()
'load array
For cnt1 = 1 To 3
For cnt2 = 1 To 3
ttt(cnt1, cnt2) = Cells(cnt1, cnt2)
Next cnt2
Next cnt1
End Function

Function anychange() As Boolean
'compare A1:C3 to previous stored in array(ttt)
anychange = False
For cnt1 = 1 To 3
For cnt2 = 1 To 3
If ttt(cnt1, cnt2) <> Cells(cnt1, cnt2) Then
If Cells(cnt1, cnt2) <> "X" And Cells(cnt1, cnt2) <> "O" Then
MsgBox "This is X or O's. Try again"
Cells(cnt1, cnt2) = vbNullString
Exit Function
End If
If Cells(cnt1, cnt2) <> pletter Then
MsgBox "You are: " & pletter & " Try again"
Cells(cnt1, cnt2) = vbNullString
Exit Function
End If
anychange = True
End If
Next cnt2
Next cnt1
End Function

Function waittime()
Dim PauseTime, Start
PauseTime = 5 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
End Function

Public Sub makeform()
'Add temporary Userform
Set Uf = ThisWorkbook.VBProject.VBComponents.Add(3)
'add textboxes
Set Tb1 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox1")
With Tb1
.Left = 30
.Top = 30
.Width = 54.25
.Height = 15.75
.ControlSource = "a1"
End With
Set Tb2 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox2")
With Tb2
.Left = 30
.Top = 70
.Width = 54.25
.Height = 15.75
.ControlSource = "a2"
End With
Set Tb3 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox3")
With Tb3
.Left = 30
.Top = 110
.Width = 54.25
.Height = 15.75
.ControlSource = "a3"
End With
Set Tb4 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox4")
With Tb4
.Left = 100
.Top = 30
.Width = 54.25
.Height = 15.75
.ControlSource = "b1"
End With
Set Tb5 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox5")
With Tb5
.Left = 100
.Top = 70
.Width = 54.25
.Height = 15.75
.ControlSource = "b2"
End With
Set Tb6 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox6")
With Tb6
.Left = 100
.Top = 110
.Width = 54.25
.Height = 15.75
.ControlSource = "b3"
End With
Set Tb7 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox7")
With Tb7
.Left = 170
.Top = 30
.Width = 54.25
.Height = 15.75
.ControlSource = "c1"
End With
Set Tb8 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox8")
With Tb8
.Left = 170
.Top = 70
.Width = 54.25
.Height = 15.75
.ControlSource = "c2"
End With
Set Tb9 = Uf.Designer.Controls.Add("Forms.Textbox.1", "TextBox9")
With Tb9
.Left = 170
.Top = 110
.Width = 54.25
.Height = 15.75
.ControlSource = "c3"
End With
With Uf.CodeModule
'cancel userform close with "X"
.insertlines 1, "Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)"
.insertlines 2, "If CloseMode = vbformcontrolmenu Then Cancel = True"
.insertlines 3, "End Sub"
.insertlines 4, "Private Sub UserForm_Activate()"
.insertlines 5, "call tictactoe"
.insertlines 6, "end sub"
.insertlines 7, "Private Sub TextBox1_Change()"
.insertlines 8, "Textbox5.SetFocus"
.insertlines 9, "End Sub"
.insertlines 10, "Private Sub TextBox2_Change()"
.insertlines 11, "TextBox5.SetFocus"
.insertlines 12, "End Sub"
.insertlines 13, "Private Sub TextBox3_Change()"
.insertlines 14, "TextBox5.SetFocus"
.insertlines 15, "End Sub"
.insertlines 16, "Private Sub TextBox4_Change()"
.insertlines 17, "TextBox5.SetFocus"
.insertlines 18, "End Sub"
.insertlines 19, "Private Sub TextBox5_Change()"
.insertlines 20, "TextBox6.SetFocus"
.insertlines 21, "End Sub"
.insertlines 22, "Private Sub TextBox6_Change()"
.insertlines 23, "TextBox5.SetFocus"
.insertlines 24, "End Sub"
.insertlines 25, "Private Sub TextBox7_Change()"
.insertlines 26, "TextBox5.SetFocus"
.insertlines 27, "End Sub"
.insertlines 28, "Private Sub TextBox8_Change()"
.insertlines 29, "TextBox5.SetFocus"
.insertlines 30, "End Sub"
.insertlines 31, "Private Sub TextBox9_Change()"
.insertlines 32, "TextBox5.SetFocus"
.insertlines 33, "End Sub"
End With
'Properties for the userform
With Uf
.Properties("Caption") = "TicTacToe Enter X or O"
.Properties("Width") = 250
.Properties("Height") = 200
End With
'Include the UF in the Userforms collection
Set vuf = VBA.UserForms.Add(Uf.Name)
'Show the Userform
vuf.Show
End Sub

Function UDFWinit(Checkspot As Integer, XO As String) As Boolean
'random number(checkspot), playing letter(XO)
'temporarily places playing letter at random location(checkspot)
'call checkwin to see if placement wins or blocks win with boolean result
'place letter(true) or return to previous(false)
UDFWinit = False
If Checkspot = 1 And [sheet1!a1] = vbNullString Then
[sheet1!a1] = XO
If checkwin Then
If XO = pletter Then
[sheet1!a1] = cletter
End If
UDFWinit = True
Else
[sheet1!a1] = vbNullString
End If
End If
If Checkspot = 2 And [sheet1!a2] = vbNullString Then
[sheet1!a2] = XO
If checkwin Then
If XO = pletter Then
[sheet1!a2] = cletter
End If
UDFWinit = True
Else
[sheet1!a2] = vbNullString
End If
End If
If Checkspot = 3 And [sheet1!a3] = vbNullString Then
[sheet1!a3] = XO
If checkwin Then
If XO = pletter Then
[sheet1!a3] = cletter
End If
UDFWinit = True
Else
[sheet1!a3] = vbNullString
End If
End If
If Checkspot = 4 And [sheet1!b1] = vbNullString Then
[sheet1!b1] = XO
If checkwin Then
If XO = pletter Then
[sheet1!b1] = cletter
End If
UDFWinit = True
Else
[sheet1!b1] = vbNullString
End If
End If
If Checkspot = 5 And [sheet1!b2] = vbNullString Then
[sheet1!b2] = XO
If checkwin Then
If XO = pletter Then
[sheet1!b2] = cletter
End If
UDFWinit = True
Else
[sheet1!b2] = vbNullString
End If
End If
If Checkspot = 6 And [sheet1!b3] = vbNullString Then
[sheet1!b3] = XO
If checkwin Then
If XO = pletter Then
[sheet1!b3] = cletter
End If
UDFWinit = True
Else
[sheet1!b3] = vbNullString
End If
End If
If Checkspot = 7 And [sheet1!c1] = vbNullString Then
[sheet1!c1] = XO
If checkwin Then
If XO = pletter Then
[sheet1!c1] = cletter
End If
UDFWinit = True
Else
[sheet1!c1] = vbNullString
End If
End If
If Checkspot = 8 And [sheet1!c2] = vbNullString Then
[sheet1!c2] = XO
If checkwin Then
If XO = pletter Then
[sheet1!c2] = cletter
End If
UDFWinit = True
Else
[sheet1!c2] = vbNullString
End If
End If
If Checkspot = 9 And [sheet1!c3] = vbNullString Then
[sheet1!c3] = XO
If checkwin Then
If XO = pletter Then
[sheet1!c3] = cletter
End If
UDFWinit = True
Else
[sheet1!c3] = vbNullString
End If
End If
End Function

Procyan
06-14-2005, 11:18 AM
Pretty Cool,
It frose two times on me but out of 5 games I won 3. I thought it was pretty funny the first time I saw the Hurry Up to. Cool Project

Mike

Zack Barresse
06-14-2005, 11:23 AM
Interesting. Didn't see the pc's moves at all. Also, it didn't clear the game when moving to another game.

Dave
06-14-2005, 02:26 PM
Thanks for your tests. Procyan.. the freezing up is the timed message box. If you happen to enter your letter at the same time as the messagebox is scheduled to appear, the message box does not appear. Instead it displays on the desktop and requires a manual click to get the messagebox to appear so it can then be removed. In the mean time, your frozen. This can be fixed with an ordinary messagebox but I sort of thought it was fun this way and it didn't seem to happen that often (and it can be fixed manually if it does happen)...so if anyone has a fix that can retain useage of the disappearing mesgbox it would be handy.
Zack.. thank you for your time. I'm not sure if I understand your difficulties unless they are related to the above. As for the clearing, if it's not too much trouble could you trial increasing the following line of code in sub TicTacToe by 1 or 2 seconds. I was recieving unexplained error warning meassages until I added this code. I don't really know why this fixed them. Dave

Application.Wait (Now + TimeValue("0:00:01"))