Here is the code hope this helps.


The code!

This goes to the standard module!!!

Type BallStatus1
Strike As Boolean
Spare As Boolean
Score As Integer
End Type
Type Oneframe1
Thisround(0 To 1) As BallStatus1
End Type
Sub Scoring2(ByVal PlayerNumber As Integer)
Dim MyScore(9) As Oneframe1
Dim MyScorePerFrame(9) As Integer
Dim colx As Integer
Dim Bunos As Integer
colx = 2
Rowx = 3 * PlayerNumber
For I = LBound(MyScore) To UBound(MyScore)

Select Case UCase(Range(Cells(Rowx, colx), Cells(Rowx, colx)).Value)
Case "X"
MyScore(I).Thisround(0).Strike = True
MyScore(I).Thisround(0).Spare = False
MyScore(I).Thisround(0).Score = 10
MyScore(I).Thisround(1).Strike = False
MyScore(I).Thisround(1).Spare = False
MyScore(I).Thisround(1).Score = 0
Case Else
MyScore(I).Thisround(0).Score = Range(Cells(Rowx, colx), Cells(Rowx,
colx)).Value
End Select
If MyScore(I).Thisround(0).Strike = False Then
TMP = UCase(Range(Cells(Rowx, colx + 1), Cells(Rowx, colx + 1)).Value)
Select Case TMP
Case "S"
MyScore(I).Thisround(1).Strike = False
MyScore(I).Thisround(1).Spare = True
MyScore(I).Thisround(1).Score = 10 - MyScore(I).Thisround(0).Score
Case Else
MyScore(I).Thisround(1).Strike = False
MyScore(I).Thisround(1).Spare = False
MyScore(I).Thisround(1).Score = Range(Cells(Rowx, colx + 1),
Cells(Rowx, colx + 1)).Value
End Select
End If
colx = colx + 2
Next I
TMP = Range(Cells(Rowx, colx - 1), Cells(Rowx, colx - 1)).Value
Select Case UCase(TMP)
Case "X"
MyScore(UBound(MyScore)).Thisround(1).Score = 10
MyScore(UBound(MyScore)).Thisround(1).Strike = True
MyScore(UBound(MyScore)).Thisround(1).Spare = False
If UCase(Range(Cells(Rowx, colx), Cells(Rowx, colx)).Value) = "X" Then
Bunos = 10
Else
Bunos = Range(Cells(Rowx, colx), Cells(Rowx, colx)).Value
End If
Case "S"
MyScore(UBound(MyScore)).Thisround(1).Score = 10 -
MyScore(UBound(MyScore)).Thisround(0).Score
MyScore(UBound(MyScore)).Thisround(1).Strike = False
MyScore(UBound(MyScore)).Thisround(1).Spare = True
If UCase(Range(Cells(Rowx, colx), Cells(Rowx, colx)).Value) = "X" Then
Bunos = 10
Else
Bunos = Range(Cells(Rowx, colx), Cells(Rowx, colx)).Value
End If
Case Else
MyScore(UBound(MyScore)).Thisround(1).Score = Range(Cells(Rowx, colx -
1), Cells(Rowx, colx - 1)).Value
MyScore(UBound(MyScore)).Thisround(1).Strike = False
MyScore(UBound(MyScore)).Thisround(1).Spare = False
Bunos = 0
End Select





For I = LBound(MyScore) To UBound(MyScore) - 1
If MyScore(I).Thisround(0).Strike = True Then
If MyScore(I + 1).Thisround(0).Strike Then
If I = UBound(MyScore) - 1 Then
MyScorePerFrame(I) = MyScore(I).Thisround(0).Score +
MyScore(I + 1).Thisround(0).Score + MyScore(I + 1).Thisround(1).Score
Else
MyScorePerFrame(I) = MyScore(I).Thisround(0).Score +
MyScore(I + 1).Thisround(0).Score + MyScore(I + 2).Thisround(0).Score
End If
Else
MyScorePerFrame(I) = MyScore(I).Thisround(0).Score +
MyScore(I + 1).Thisround(0).Score + MyScore(I + 1).Thisround(1).Score
End If

ElseIf MyScore(I).Thisround(1).Spare = True Then
MyScorePerFrame(I) = MyScore(I).Thisround(0).Score +
MyScore(I).Thisround(1).Score + MyScore(I + 1).Thisround(0).Score
ElseIf (MyScore(I).Thisround(0).Strike = False) And
(MyScore(I).Thisround(1).Spare = False) Then
MyScorePerFrame(I) = MyScore(I).Thisround(0).Score +
MyScore(I).Thisround(1).Score
End If
Next I
MyScorePerFrame(UBound(MyScore)) =
MyScore(UBound(MyScore)).Thisround(0).Score +
MyScore(UBound(MyScore)).Thisround(1).Score + Bunos
TMP = 0
'output score
colx = 2
Rowx = PlayerNumber * 3 + 1
For I = LBound(MyScore) To UBound(MyScore) - 1
TMP = MyScorePerFrame(I) + TMP
Range(Cells(Rowx, colx), Cells(Rowx, colx)).Value = TMP
colx = colx + 2
Next I
Range(Cells(Rowx, colx), Cells(Rowx, colx)).Value = TMP +
MyScorePerFrame(UBound(MyScore))
End Sub


And this goes the sheet module!!!


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo en
Application.EnableEvents = False
Application.ScreenUpdating = False
Set isect = Application.Intersect(Target, Range("b2:V11"))
If Not isect Is Nothing Then
PlayerNumber = ActiveCell.Row / 3
Call Scoring2(PlayerNumber)
End If
en:
If Err.Number < 0 Then
MsgBox "Error occurs" & Chr(13) & Err.Number
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub