add player score to team score

breilly00

Board Regular
Joined
Sep 15, 2008
Messages
53
Office Version
  1. 365
Platform
  1. Windows
I am trying to create a score sheet to display on our external monitor during our pool game. We have 2 teams of 4 players each. When a player 1, on team 1 scores points we want to enter the player score and have that score added to the team score. When player 2, on team 1 shoots their score is added to the team score. This continues under either team 1 or team 2 reaches the number of game winning points. The problem I have is when player 1 score is entered it needs to be added to the total and then not added to the total when player 2 shoots and their score is added to the total.

How can I set it up so when the next player plays and their score is entered it does not include the previous players score. I would like to erase the previous players score when the current players score is entered so only the last players score is displayed. Also a nice to have will be to be able to identify (highlight the players name) the player who is up next once the current players score is entered. Eg. Player 4 is identified that it is their turn when player 3 score is entered. and the player 1 is highlighted when player 4 score is entered.

For example

Team 1
Player Score
Player 1 X
Player 2 X
Player 3 X
Player 4 X

Team 1 score XXXX

Team 2
Player Score
Player 1 X
Player 2 X
Player 3 X
Player 4 X

Team 2 score XXXX
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
@breilly00

Thanks for the step-by-step process. Give this a try. Remove the previous Worksheet_Change I provided (and MAIT's Worksheet_BeforeDoubleClick code if it is in this sheet's module) and replace with all of this. Don't miss the Private Const line at the top.

VBA Code:
Private Const TotalRow As Long = 8

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Row = TotalRow And IsNumeric(Target.Value) And Len(Target.Value) > 0 Then
    Application.EnableEvents = False
    Rows(Target.Row).Interior.Color = xlNone
    Range("B:B,E:E").SpecialCells(xlConstants, xlNumbers).ClearContents
    Range("A3:D6").Interior.Color = xlNone
    Range("A3").Interior.Color = RGB(146, 208, 80)
    Range("B3").Select
    Application.EnableEvents = True
  End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Changed As Range
  Dim TeamTotal As Double
  Dim PlayerScore As Variant
  Dim nr As Long, nc As Long
 
  Set Changed = Intersect(Target, Range("B:B,E:E"), Rows("3:6"))
  If Not Changed Is Nothing Then
    If Changed.Count = 1 Then
      PlayerScore = Changed.Value
      If IsNumeric(PlayerScore) And PlayerScore <> "" Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        nr = Changed.Row
        With Changed.EntireColumn
          TeamTotal = PlayerScore + .Cells(TotalRow).Value
          On Error Resume Next
          .SpecialCells(xlConstants, xlNumbers).ClearContents
          On Error GoTo 0
          Changed.Value = PlayerScore
          .Cells(TotalRow).Value = TeamTotal
          If TeamTotal >= 200 Then .Cells(TotalRow).Interior.Color = RGB(0, 176, 240)
          Range("A3:D6").Interior.Color = xlNone
          nc = IIf(.Column = 2, 4, 1)
          If nc = 1 Then nr = IIf(Changed.Row = 6, 3, Changed.Row + 1)
          Cells(nr, nc).Interior.Color = RGB(146, 208, 80)
          Cells(nr, nc + 1).Select
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
      End If
    End If
  End If
End Sub

If I understood the step-by-step scoring process this should ..
- updates the team total score when a player score is entered
- highlight the next player's name
- select the cell beside that next player's name ready for their score entry
- when a team total reaches 200 it should highlight blue
- when a team reaches 200 (or any time that you want to re-set the scores to zero and start again, double-click either one of the team total scores in row 8
 
Upvote 0
And I write many many kind words to you. They roll to the ‘down under’ with great admiration and respect to someone who went further than I ever could have gotten on my own. I asked for some guidance on how to start and you responded with giving me code. What a Crikey!!! You make the Mr. Excel web site what it is. Providing patience and understanding to the ‘new-bees’ that are trying to get a foothold in Excel.
 
Upvote 0
You're welcome. Glad it worked for you. Thanks for your generous comments. :)
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,287
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top