Code to Accept only a 0 or this...

[6afraidbecause789]

Hi - The code below validates cells to accept any 3-digit combination
of 4 numbers, 1-4 (cells are text), and corrects users if they mistype
in the cell. How can the code also simply accept one digit, a 0--the
cells must contain a 0 or this 3-digit combo. Thanks to Rick and
others for the following code.

=============================

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim myIntersect As Range
Set myIntersect = Intersect(Target, Me.Range("ABCper7"))
If myIntersect Is Nothing Then Exit Sub
On Error Resume Next 'just fly by errors
Application.EnableEvents = False
'code help by Rick R.
For Each myCell In myIntersect.Cells
myCell = Left(myCell, 3)
If myCell Like "[0-4][0-4][0-4]" And Not myCell Like "*0*0*" Then
myCell.Value = String(3, CStr(myCell.Value))
Else
MsgBox "First, enter a 0, 1, 2, 3, or 4 for an A score." & Chr(13) &
Chr(10) & _
"Then, enter a B score." & Chr(13) & Chr(10) & _
"Lastly, enter a C score." & Chr(13) & Chr(10) & _
"The value may be a 0 (unexcused absense) or any combination of" &
Chr(13) & Chr(10) & _
"1 through 4, with zeros allowed for B-C scores.", vbOKOnly

myCell.Value = ""
End If
Next myCell
Application.EnableEvents = True
On Error GoTo 0
End Sub

Thanks

 

[Bernard Liengme]

This seems to work but I did not test the rest of your code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim myIntersect As Range
Set myIntersect = Intersect(Target, Me.Range("ABCper7"))
If myIntersect Is Nothing Then Exit Sub
On Error Resume Next 'just fly by errors
Application.EnableEvents = False
'code help by Rick R.
For Each myCell In myIntersect.Cells
If myCell.Value = 0 Then Exit For 'this is a new line
ETC....

best wishes

 

[6afraidbecause789]

Hmmm, just one line of code. Thanks Bernard.