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

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
--
Bernard V Liengme
Microsoft Excel MVP
http://people.stfx.ca/bliengme
remove caps from email

<(E-Mail Removed)> wrote in message
news:e75dee7e-775f-472d-bda5-(E-Mail Removed)...
> 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

Hmmm, just one line of code. Thanks Bernard.