Limit an InputBox value to 40 or show Message Box warning

[grady121]

With help from this forum I was able to obtain the following code.
An InputBox is used to enter a Player golf score in column L, for each Player listed in column B.

It includes a Message box catch that only appears if the score is above 99 (3 numerical numbers), then re-shows the Players name enabling me to re-enter the score.

What I would prefer now is a code that will replaces the existing catch with a new one, based on any score entered over 40.

Ideally, just a simple Yes/No Message box asking: “Are you sure the score entered is correct?”

If Yes is clicked, then carry on and insert the score. Or No, to re-enter the Players correct score.

Any help appreciated.

Sub Add_Score()
 
    Dim ListRow, ListColumn, ScoreColumn As Integer
    Dim MyNewScore As String
    
    ' Using Names listed in Column 2 (Starting at Row B10), Add new Scores to Column 12 (L)
    Application.ScreenUpdating = True
    ListRow = 10: ListColumn = 2: ScoreColumn = 12
    
    While ActiveSheet.Cells(ListRow, ListColumn) <> "" ' Until names run out
        Do
            MyNewScore = InputBox("Enter the Scores for:- " & vbNewLine & vbNewLine _
            & ActiveSheet.Cells(ListRow, ListColumn) & vbNewLine & vbNewLine & vbNewLine _
            & "Click 'OK' or press 'Enter' to add next players score." & vbNewLine & vbNewLine _
            & "(If a Player did not play - click 'OK' or press 'Enter')", _
            "Add Scores", ActiveSheet.Cells(ListRow, ScoreColumn))
            
            ' Limit the score to 1 or 2 numbers or ""
            If Len(MyNewScore) > 2 Then MsgBox "The score for:- '" & ActiveSheet.Cells(ListRow, ListColumn) & "' is too high." & vbCrLf & vbCrLf _
                     & "Max of 2 Numbers ! ... Please re-enter score.", vbOKOnly + vbCritical, "Score Error"
        Loop Until (MyNewScore Like "#") Or (MyNewScore Like "##") Or (MyNewScore = "")
    
        If MyNewScore <> "" Then
            ActiveSheet.Cells(ListRow, ScoreColumn) = MyNewScore  'If input is not empty, use the input
        Else: ActiveSheet.Cells(ListRow, ScoreColumn) = ""
        End If
        ListRow = ListRow + 1
    Wend
    
End Sub

 

[Michael M]

Try

Sub Add_Score()
 
    Dim ListRow, ListColumn, ScoreColumn As Integer
    Dim MyNewScore As String
    
    ' Using Names listed in Column 2 (Starting at Row B10), Add new Scores to Column 12 (L)
    Application.ScreenUpdating = True
    ListRow = 10: ListColumn = 2: ScoreColumn = 12
    
    While ActiveSheet.Cells(ListRow, ListColumn) <> "" ' Until names run out
        Do
            MyNewScore = InputBox("Enter the Scores for:- " & vbNewLine & vbNewLine _
            & ActiveSheet.Cells(ListRow, ListColumn) & vbNewLine & vbNewLine & vbNewLine _
            & "Click 'OK' or press 'Enter' to add next players score." & vbNewLine & vbNewLine _
            & "(If a Player did not play - click 'OK' or press 'Enter')", _
            "Add Scores", ActiveSheet.Cells(ListRow, ScoreColumn))
            
            ' Limit the score to 1 or 2 numbers or ""
            If MyNewScore > 40 Then MsgBox "Are you sure the score for:- '" & ActiveSheet.Cells(ListRow, ListColumn) & "' is correct ??" & vbCrLf & vbCrLf _
                     & "Score must be 40 or less ! ... Please re-enter score.", vbOKOnly + vbCritical, "Score Error"
        Loop Until (MyNewScore Like "#") Or (MyNewScore Like "##") Or (MyNewScore = "")
    
        If MyNewScore <> "" Then
            ActiveSheet.Cells(ListRow, ScoreColumn) = MyNewScore  'If input is not empty, use the input
        Else: ActiveSheet.Cells(ListRow, ScoreColumn) = ""
        End If
        ListRow = ListRow + 1
    Wend
    
End Sub

 

[Michael M]

Sorry, typo in last post....try

Sub Add_Score()
 
    Dim ListRow, ListColumn, ScoreColumn As Integer
    Dim MyNewScore As String
    
    ' Using Names listed in Column 2 (Starting at Row B10), Add new Scores to Column 12 (L)
    Application.ScreenUpdating = True
    ListRow = 10: ListColumn = 2: ScoreColumn = 12
    
    While ActiveSheet.Cells(ListRow, ListColumn) <> "" ' Until names run out
        Do
            MyNewScore = InputBox("Enter the Scores for:- " & vbNewLine & vbNewLine _
            & ActiveSheet.Cells(ListRow, ListColumn) & vbNewLine & vbNewLine & vbNewLine _
            & "Click 'OK' or press 'Enter' to add next players score." & vbNewLine & vbNewLine _
            & "(If a Player did not play - click 'OK' or press 'Enter')", _
            "Add Scores", ActiveSheet.Cells(ListRow, ScoreColumn))
            
            ' Limit the score to 1 or 2 numbers or ""
            If MyNewScore > 40 Then MsgBox "Are you sure the score for:- '" & ActiveSheet.Cells(ListRow, ListColumn) & "' is correct ??" & vbCrLf & vbCrLf _
                     & "Score must be 40 or less ! ... Please re-enter score.", vbOKOnly + vbCritical, "Score Error"
        Loop Until (MyNewScore <= 40) Or (MyNewScore = "")
    
        If MyNewScore <> "" Then
            ActiveSheet.Cells(ListRow, ScoreColumn) = MyNewScore  'If input is not empty, use the input
        Else: ActiveSheet.Cells(ListRow, ScoreColumn) = ""
        End If
        ListRow = ListRow + 1
    Wend
    
End Sub

 

[grady121]

Thanks Michael,

I'm not hot on Loops but managed to come up with the following code, it seems to do what I need:

Sub Add_Score()
 
    Dim ListRow, ListColumn, ScoreColumn, iRet As Integer
    Dim MyNewScore As String
    
    ' Using Names listed in Column 2 (Starting at Row B10), Add new Scores to Column 12 (L)
    Application.ScreenUpdating = True
    ListRow = 10: ListColumn = 2: ScoreColumn = 12
    
    While ActiveSheet.Cells(ListRow, ListColumn) <> "" ' Until names run out
        Do
            MyNewScore = InputBox("Enter the Scores for:- " & vbNewLine & vbNewLine _
            & ActiveSheet.Cells(ListRow, ListColumn) & vbNewLine & vbNewLine & vbNewLine _
            & "Click 'OK' or press 'Enter' to add next players score." & vbNewLine & vbNewLine _
            & "(If a Player did not play - click 'OK' or press 'Enter')", _
            "Add Scores", ActiveSheet.Cells(ListRow, ScoreColumn))
            
            If MyNewScore = "" Then GoTo SCORE_OK
            
            ' Warn if score is over 40
            If MyNewScore > 40 Then iRet = _
                    MsgBox(ActiveSheet.Cells(ListRow, ListColumn) & " scored:- " _
                    & MyNewScore & ", is that correct ???" & vbCrLf & vbCrLf _
                    & "If not, just click 'No' to re-enter the score.", vbYesNo + vbQuestion, "Score Check")
            If iRet = vbYes Then GoTo SCORE_OK
        Loop Until (MyNewScore <= 40) Or (MyNewScore = "")
SCORE_OK:

        If MyNewScore <> "" Then
            ActiveSheet.Cells(ListRow, ScoreColumn) = MyNewScore  'If input is not empty, use the input
        Else: ActiveSheet.Cells(ListRow, ScoreColumn) = ""
        End If
        ListRow = ListRow + 1 ' Move to next Row
    Wend
    
End Sub

Thanks again for your suggestion