Best implementation of scoring sheet for grandkids

[JenniferMurphy]

The grandkids love games, especially computer games. When they were little, we played tic-tac-toe. Now we are into more difficult games, like Connect 4. I recently played against my 9 year old, Susie. She beat me several games in a row, so she started keeping score. That gave me an idea to create a scoring sheet that we could use to keep a running score. I might add a graph. In addition to keeping score, it might pique their interest in spreadsheets in particular and math in general. It might give me a chance to show them how it works.

My initial thought was a table something like this with a control button that would add a row and increment the corresponding score.

But Susie has siblings who will almost certainly want to play and she may want to play against mom or dad. So now I am thinking of a more general design that can be easily adapted to any two players, something like this.

I would assign the name Player1 to the cell currently containing "Susie" and Player2 to the one containing "Gramma". The Score It button would ask who won and score it accordingly. If all names are local to the sheet, I should be able to easily make a copy, change the names, and everyhting should continue to work.

A couple of questions:

1. Does anyone see a problem with this plan?
2. Is there a better way?
3. Is there a way I can have a MsgBox-like control, but with buttons that have the names of the two players, instead of Yes and No? How about if I have the players select the name of the winner and then click the Score It button. The code can check the the selected cell for the name?

I would appreciate any suggetions.

Thanks

 

[bebo021999]

With button from Form Object, refer to its properties "name", like this:

Me.Shapes("Button 7").OLEFormat.Object.Caption

In my sample file, I am working with Button 7 & 8 & 9

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B5:C5")) Is Nothing Then Exit Sub
Me.Shapes("Button 7").OLEFormat.Object.Caption = Range("B5").Text
Me.Shapes("Button 8").OLEFormat.Object.Caption = Range("C5").Text
End Sub

Sub collect()
Dim lr&, i&, k&, rng, arr(1 To 1000, 1 To 3)
lr = WorksheetFunction.Max(6, Cells(Rows.Count, "B").End(xlUp).Row)
rng = Range("A6:C" & lr).Value
k = 1
For i = 1 To UBound(rng)
    k = k + 1
    arr(k, 1) = rng(i, 1): arr(k, 2) = rng(i, 2): arr(k, 3) = rng(i, 3)
Next
Range("A6").Resize(k, 3).Value = arr
End Sub

Sub Button7_Click()
collect
Range("A6").Value = Me.Shapes("Button 7").OLEFormat.Object.Caption
Range("B6").Value = Range("B7").Value + 1
Range("C6").Value = Range("C7").Value + 0
End Sub
Sub Button8_Click()
collect
Range("A6").Value = Me.Shapes("Button 8").OLEFormat.Object.Caption
Range("B6").Value = Range("B7").Value + 0
Range("C6").Value = Range("C7").Value + 1
End Sub
Sub Button9_Click()
Range("A6:C6").Delete shift:=xlUp
End Sub

game.xlsm

drive.google.com

 

[JenniferMurphy]

With button from Form Object, refer to its properties "name", like this:

Ok, thanks. I'll play with that. In your opinion, which is better for this application?

In general, do you prefer Active-X controls. If so, can you say why?

Thanks

 

[bebo021999]

For this sample, form controls are simpler and better. Though, in VBA code, its complicate a bit to get its properties
Active X controls have more options to work with bigger project. (For ex, ActiveX control: holdover mouse even,..., get the object position in sheet...)

 

[JenniferMurphy]

bebo,

I downloaded your new game.xlsm. The Susie and Gramma buttons work, but I get this error when I click on Undo:

 

[bebo021999]

Could you share sample file? If it's inconvernience to be published, try send to my email: accshingda@gmail.com

 

[JenniferMurphy]

OK! I think I have it all working.

I really learned a lot from this exercise. I just hope I can remember it all. Thank you.

Here's my code. It's way less compact than yours, but I need this detail to be able to understand it. I didn't understand your "Collect" code.

Next I'm going to merge the Player1 and Player2 code. I welcome anuy comments or suggestions.

Option Explicit

'==========================================================
' Global Variables
'==========================================================
Const rnWinnerHdr  As String = "WinnerHdr"    'Range name
Const rnPlayer1Hdr As String = "Player1Hdr"   'Range name
Const rnPlayer2Hdr As String = "Player2Hdr"   'Range name


'=========================================================
'       Worksheet Change Macro

' Runs whenever anything on the sheet changes
'==========================================================
Private Sub Worksheet_Change(ByVal Target As Range)

'If the Player1 header has changed, change that button text to match
If Not Intersect(Target, Range(rnPlayer1Hdr)) Is Nothing Then
  Me.Shapes("Player1 Button").OLEFormat.Object.Caption = Range("Player1Hdr").Text
End If

'If the Player2 header has changed, change that button text to match
If Not Intersect(Target, Range(rnPlayer2Hdr)) Is Nothing Then
  Me.Shapes("Player2 Button").OLEFormat.Object.Caption = Range("Player2Hdr").Text
End If

End Sub


'==========================================================
' Score a win for Player 1
'==========================================================
Sub Player1Button_Click()

'Insert a new row
Rows(Range(rnPlayer1Hdr).Offset(1, 0).row).Insert shift:=xlDown
Range(rnWinnerHdr).Offset(1, 0).Select
With Selection
  .Value = Me.Shapes("Player1 Button").OLEFormat.Object.Caption
  .HorizontalAlignment = xlLeft
  .Font.Bold = False
End With

Range(rnPlayer1Hdr).Offset(1, 0).Select   'Add 1 to player1's score
With Selection
  .Value = Range(rnPlayer1Hdr).Offset(2, 0) + 1
  .HorizontalAlignment = xlCenter
  .Font.Bold = False
End With

Range(rnPlayer2Hdr).Offset(1, 0).Select   'Keep player2's score the same
With Selection
  .Value = Range(rnPlayer2Hdr).Offset(2, 0)
  .HorizontalAlignment = xlCenter
  .Font.Bold = False
End With

End Sub


'==========================================================
' Score a win for Player 2
'==========================================================
Sub Player2Button_Click()

'Insert a new row
Rows(Range(rnPlayer1Hdr).Offset(1, 0).row).Insert shift:=xlDown
Range(rnWinnerHdr).Offset(1, 0).Select
With Selection
  .Value = Me.Shapes("Player2 Button").OLEFormat.Object.Caption
  .HorizontalAlignment = xlLeft
  .Font.Bold = False
End With

Range(rnPlayer1Hdr).Offset(1, 0).Select   'Keep player1's score the same
With Selection
  .Value = Range(rnPlayer1Hdr).Offset(2, 0)
  .HorizontalAlignment = xlCenter
  .Font.Bold = False
End With

Range(rnPlayer2Hdr).Offset(1, 0).Select   'Add 1 to player2's score
With Selection
  .Value = Range(rnPlayer2Hdr).Offset(2, 0) + 1
  .HorizontalAlignment = xlCenter
  .Font.Bold = False
End With

End Sub


'==========================================================
' Undo the last score
'=========================================================
Sub UndoButton_Click()

'Delete each cell in the top row and shoft that column up
Range(rnWinnerHdr).Offset(1, 0).Delete shift:=xlUp
Range(rnPlayer1Hdr).Offset(1, 0).Delete shift:=xlUp
Range(rnPlayer2Hdr).Offset(1, 0).Delete shift:=xlUp

End Sub

 

[JenniferMurphy]

Could you share sample file? If it's inconvernience to be published, try send to my email: accshingda@gmail.com

It is your file. I didn't change anything. I just downloaded and ran it.

 

[bebo021999]

It is your file. I didn't change anything. I just downloaded and ran it.

I see.
Just move button 9 code from sheet to module.

 

[JenniferMurphy]

I see.
Just move button 9 code from sheet to module.

That fixed it, but I am puzzled as to why. My code is all in the sheet as is yours in the first one you sent.

 

[bebo021999]

That fixed it, but I am puzzled as to why. My code is all in the sheet as is yours in the first one you sent.

Because all sub (except button9) have connection together.
Button9 is independent.