I did not verify that the last character in the second rule
is a character, use this code:
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
<<<<snip

Here is your coder restructured to reduce it to almost half its original
size. You should particularly note my use of the Like operator to "simplify"
the testing for the two different patterns.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
Dim xCell As Range, Msg As String, MsgText As String, Answer As Long
Const Pattern1 As String = "AB or SB followed by five " & _
"digits followed by a C or S"
Const Pattern2 As String = "five digits followed by an uppercase letter"
Msg = "One cell (XXX) or more do not match the required pattern of " & _
"PPP." & vbCrLf & vbCrLf & "Do you want to STOP saving the " & _
"workbook in order to correct the data?"
For Each xCell In Range("Valzone1")
If Len(xCell) 0 And Not xCell Like "[AS]B#####[CS]" Then
MsgText = Replace(Msg, "XXX", xCell.Address(0, 0))
MsgText = Replace(MsgText, "PPP", Pattern1)
Answer = MsgBox(MsgText, vbCritical Or vbYesNo)
If Answer = vbYes Then GoTo BadCell
End If
Next
For Each xCell In Range("Valzone2")
If Len(xCell) 0 And Not xCell Like "#####[A-Z]" Then
MsgText = Replace(Msg, "XXX", xCell.Address(0, 0))
MsgText = Replace(MsgText, "PPP", Pattern2)
Answer = MsgBox(MsgText, vbCritical Or vbYesNo)
If Answer = vbYes Then GoTo BadCell
End If
Next
Exit Sub
BadCell:
xCell.Select
Cancel = True
End Sub


Rick Rothstein (MVP - Excel)