Hi Guys, I would like to find out how to make use of excel vba to make
cells mandatory, restricted field length and also input pattern before
file can be save.

Like a cell is only allow to have 8 alphanumeric field length,
starting first 2 character must be AB or SB and the last character
have to be C or S. Another cell is only allow to have 6 (5 numeric and
1 alphanumeric on the last character) field length.

Any help would be appreciated. Thanks everyone.

Hello,


First name your range that should be validated with the first rule with
the name Valzone1

Second name your range that should be validated with the second rule with
the name Valzone1

(I assumed that these zones should only contains uppercase characters)

Then you could try to paste the following code into the event
subroutine of your workbook i.e. into Sub Workbook_BeforeSave.... :

'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Valzone As Range, xCell As Range
Dim isOK As Boolean, Formula As String
Dim msg As String, Answer, xVal, k

For Each xCell In Range("Valzone1")
If xCell.Value < "" Then
Formula = "=AND(OR(MID(ww,1,2)= ""ab"",MID(ww,1,2)= ""sb""),OR(MID(ww,8,1)= ""c"",MID(ww,8,1)= ""s""),LEN(ww)=8,EXACT(UPPER(ww),ww))"
Formula = Replace(Formula, "ww", xCell.Address)
isOK = Evaluate(Formula)
If Not isOK Then
msg = "One cell (" & xCell.Address & ") or more do not match the required pattern i.e. :" & vbCrLf & vbCrLf
msg = msg & "- 8 alphanumeric field length," & vbCrLf
msg = msg & "- starting first 2 characters must be AB or SB" & vbCrLf
msg = msg & "- the last character have to be C or S" & vbCrLf
msg = msg & "- uppercase characters" & vbCrLf & vbCrLf
msg = msg & "Do you want to STOP saving the workbook (to correct the data) ?"
Answer = MsgBox(msg, 20)
If Answer = vbYes Then
xCell.Select
Cancel = True
Exit Sub
End If
End If
End If
Next xCell

For Each xCell In Range("Valzone2")
xVal = xCell.Value
If xCell.Value < "" Then
isOK = True
If Len(xVal) = 6 Then
For k = 1 To 6
Select Case Mid(xVal, k, 1)
Case "0" To "9"
Case "A" To "Z"
Case Else
isOK = False
End Select
Next k
Else
isOK = False
End If
End If

If Not isOK Then
msg = "One cell (" & xCell.Address & ") or more do not match the required pattern i.e. :" & vbCrLf & vbCrLf
msg = msg & "- 6 alphanumeric field length," & vbCrLf
msg = msg & "- starting first 5 characters must be numeric characters" & vbCrLf
msg = msg & "- the last character must be Apha" & vbCrLf
msg = msg & "- uppercase characters" & vbCrLf & vbCrLf
msg = msg & "Do you want to STOP saving the workbook (to correct the data) ?"
Answer = MsgBox(msg, 20)
If Answer = vbYes Then
xCell.Select
Cancel = True
Exit Sub
End If
End If
Next xCell

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''

This code will be execute each time the workbook is saved

Hope it will help you,



Jenovauh avait énoncé :
Hi Guys, I would like to find out how to make use of excel vba to make
cells mandatory, restricted field length and also input pattern before
file can be save.

Like a cell is only allow to have 8 alphanumeric field length,
starting first 2 character must be AB or SB and the last character
have to be C or S. Another cell is only allow to have 6 (5 numeric and
1 alphanumeric on the last character) field length.

Any help would be appreciated. Thanks everyone.

Sorry,

replace :

"First name your range that should be validated with the first rule
with
the name Valzone1

Second name your range that should be validated with the second rule
with the name Valzone1"



with

"1) Name your range, that should be validated with the first rule, with
the name Valzone1

2) Name your range, that should be validated with the second rule, with
the name Valzone2"

== the second name was false <== (copy/paste too fast !)





Charabeuh a émis l'idée suivante :
Second name your range that should be validated with the second rule with
the name Valzone1

Another mistake:

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)
Dim Valzone As Range, xCell As Range
Dim isOK As Boolean, Formula As String
Dim msg As String, Answer, xVal, k

For Each xCell In Range("Valzone1")
If xCell.Value < "" Then
Formula = "=AND(OR(MID(ww,1,2)= ""ab"",MID(ww,1,2)=
""sb""),OR(MID(ww,8,1)= ""c"",MID(ww,8,1)=
""s""),LEN(ww)=8,EXACT(UPPER(ww),ww))"
Formula = Replace(Formula, "ww", xCell.Address)
isOK = Evaluate(Formula)
If Not isOK Then
msg = "One cell (" & xCell.Address & ") or more do not match the
required pattern i.e. :" & vbCrLf & vbCrLf
msg = msg & "- 8 alphanumeric field length," & vbCrLf
msg = msg & "- starting first 2 characters must be AB or SB" &
vbCrLf
msg = msg & "- the last character have to be C or S" & vbCrLf
msg = msg & "- uppercase characters" & vbCrLf & vbCrLf
msg = msg & "Do you want to STOP saving the workbook (to correct
the data) ?"
Answer = MsgBox(msg, 20)
If Answer = vbYes Then
xCell.Select
Cancel = True
Exit Sub
End If
End If
End If
Next xCell

For Each xCell In Range("Valzone2")
xVal = xCell.Value
If xCell.Value < "" Then
isOK = True
If Len(xVal) = 6 Then
For k = 1 To 5
If Mid(xVal, k, 1) < "0" Or Mid(xVal, k, 1) "9" Then
isOK = False
Next k
If Mid(xVal, 6, 1) < "A" Or Mid(xVal, 6, 1) "Z" Then isOK =
False
Else
isOK = False
End If
End If

If Not isOK Then
msg = "One cell (" & xCell.Address & ") or more do not match the
required pattern i.e. :" & vbCrLf & vbCrLf
msg = msg & "- 6 alphanumeric field length," & vbCrLf
msg = msg & "- starting first 5 characters must be numeric
characters" & vbCrLf
msg = msg & "- the last character must be Apha" & vbCrLf
msg = msg & "- uppercase characters" & vbCrLf & vbCrLf
msg = msg & "Do you want to STOP saving the workbook (to correct
the data) ?"
Answer = MsgBox(msg, 20)
If Answer = vbYes Then
xCell.Select
Cancel = True
Exit Sub
End If
End If
Next xCell

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''

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)

Thank you Rick,

Charabeuh.

@Rick,
Great example of using Like()! I'm saving this one...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc