Game security code needed

[Steve Garman]

We had this really imporant meeting with the Chief Exec this morning and
the two most senior sales reps were invited as a "consultation exercise"

Knowing the reps would be bored, I spent 15 long minutes developing an
app to keep them occupied in the meeting (code below)

However, no more than 5 minutes into the meeting, not only were they
projecting the worksheet over my masterly whiteboard presentation but
they were also /cheating/ at noughts and crosses.

Can anyone provide any code to stop them cheating in future meetings
please? Something to stop there being 5 crosses and one nought on the
board would be a start

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
'noughts and crosses (tic-tac-toe) in A1:C3
Dim x%
Static s$
With Target
If .Cells.Count > 1 Then Exit Sub
If .Row > 3 Or .Column > 3 Then Exit Sub
If .Value <> "" Then Exit Sub
If s$ = "X" Then s$ = "O" Else s$ = "X"
.Formula = s$
Cancel = True
x% = .Column
Application.StatusBar = False
If Cells(1, x%).Value = Cells(2, x%).Value Then
If Cells(1, x%).Value = Cells(3, x%).Value Then
Application.StatusBar = .Value & " Wins (column)"
Exit Sub
End If
End If
x% = .Row
If Cells(x%, 1).Value = Cells(x%, 2).Value Then
If Cells(x%, 1).Value = Cells(x%, 3).Value Then
Application.StatusBar = .Value & " Wins (row)"
Exit Sub
End If
End If
'don't check diagonals if center square blank
If Cells(2, 2).Value = "" Then Exit Sub
If Cells(1, 1).Value = Cells(2, 2).Value Then
If Cells(1, 1).Value = Cells(3, 3).Value Then
Application.StatusBar = .Value & " Wins (diag)"
End If
End If
If Cells(1, 3).Value = Cells(2, 2).Value Then
If Cells(1, 3).Value = Cells(3, 1).Value Then
Application.StatusBar = .Value & " Wins (diag2)"
End If
End If
End With
End Sub

 

[Guest]

Steve

I don't follow this

Joe

 

[Dick Kusleika]

Steve

How are they doing it? Your static variable changes every time, so I'm not
seeing how it could get that way. I have no doubt that it is (because
you've probably seen it), I was just wondering if you knew the reason.

First, hide all the rows below row3 and all the columns right of C. Then
you don't have to check if they click outside the grid.

Then you could change the way you set s$. Dim it outside the procedure and
it will hold it's value (like it does dimmed as Static within the
procedure). How about something like this

Dim XCnt as Long
Dim OCnt as Long
Dim i as Long

For i = 1 to 3
XCnt = XCnt + Application.Countif(Me.Columns(i),"X")
OCnt = OCnt + Application.Countif(Me.Columns(i), "O")
Next i

If XCnt > OCnt Then
s$ = "O"
Else
s$ = "X"
End If

 

[Dick Kusleika]

Steve

Wait, I get it. They're just typing X's and O's instead of using the right
click. Use the Worksheet_Change event and erase anything that gets put into
the cells.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True

End Sub


Make sure you use EnableEvents in your BeforeRightClick sub so that when you
change cells, it doesn't fire.

 

[Steve Garman]

Thanks Dick, replies inline.

Steve

How are they doing it? Your static variable changes every time, so I'm not
seeing how it could get that way. I have no doubt that it is (because
you've probably seen it), I was just wondering if you knew the reason.

They're using the keyboard! Specifically the Del key at the moment.

First, hide all the rows below row3 and all the columns right of C. Then
you don't have to check if they click outside the grid.

Thanks. I came to that conclusion myself later when I revisited it.

Then you could change the way you set s$. Dim it outside the procedure and
it will hold it's value (like it does dimmed as Static within the
procedure). How about something like this

To be honest, part of the challenge I set myself when writing it was to
include all the code in the one event without disabling events or
causing problems. But you are right, the static variable is a bit pointless.

Dim XCnt as Long
Dim OCnt as Long
Dim i as Long

For i = 1 to 3
XCnt = XCnt + Application.Countif(Me.Columns(i),"X")
OCnt = OCnt + Application.Countif(Me.Columns(i), "O")
Next i

If XCnt > OCnt Then
s$ = "O"
Else
s$ = "X"
End If

Yes, that's a real improvement. I like that. Thanks.

 

[Steve Garman]

That's great thanks.
As I see it it just leaves one problem.
When they use the delete key, followed by right-clicking a different cell.

I'll mull that over and see if I can crack it.

Thanks again

 

[Dick Kusleika]

Steve

What were you saying about one event? Here's one way - I don't know if it's
foolproof.

Dim OldValue as String 'in Declarations section

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Target.Value = OldValue
Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

OldValue = Target.Value

End Sub

You also have to set OldValue = s$ in your BeforeRightClick event.

This has been a fun Friday afternoon project. Send me your workbook when
you're done and I'll send you mine, if you like.

 

[Steve Garman]

Dick,

thanks for all your help.

The experience I've gained in this little project will be invaluable in
the future.

I've mailed my workbook to my best guess at your unmunged address.
Please let me know if you don't receive it.

I'd be delighted to see your version if you have the time to mail it to me.

 

[Steve Garman]

Arggghhhh!

I sent you the copy with the wrong announceWinner sub in it,
the statements are the wrong way round.

It should read:

Private Sub announceWinner(msg$)
weHaveWinner = True
clearCells msg$ & vbLf & vbLf & "Clear the board", "Winner"
End Sub

It hardly seems worth resending the whole workbook.

 

[Steve Garman]

Apologies folks, that wasn't meant for the newsgroup.

I've fiddled with this a little more.

In the unlikely event that anyone else is interested, theres a copy of
my completed(?) workbook at
http://www.sgarman.net/usenet/ticTacToe.xls

 

[Rob van Gelder]

That's cool!

Nice work.

 

[Dick Kusleika]

Steve

Here's mine

http://www.dicks-clicks.com/excel/downloads/tictactoe.xls

 

[Guest]

I probably just have no idea what I am doing. But I can't
for the life of me figure out how to run this. can anyone
help?

 

[Tom Ogilvy]

Look at the original thread - there was a bit of discussion:

http://groups.google.com/[email protected]

but to run the code you posted, right click on a sheet tab and select view
code. Paste the code in the resulting module. Clean up any errors due to
word wrap. Now go to the worksheet and right click in the Range("A1:C3) -
the code should run and place an X or O for each right click in that range
until a winner has been determined - look down at the status bar. Not a
whole lot of visual feedback.