Data validation, mandatory and restricted field length for excel vbs

[Jenovauh]

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.

 

[Charabeuh]

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é :

 

[Charabeuh]

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 :

 

[Charabeuh]

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

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

 

[Rick Rothstein]

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)

 

[Charabeuh]

Thank you Rick,

Charabeuh.

 

[GS]

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

 

[Rick Rothstein]

@Rick,

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

Just so one reading this thread gets confused, you have a typo above...
there should not be any parentheses shown following the keyword "Like" as it
is an operator, not a function.

As for the Like operator itself... I really love it... it can make some
cumbersome text expression testing much easier. Not quite a Regular
Expression parser (actually, not even close to being one), yet it offers
simple, and fairly readable, parsing syntax, something a Regular Expression
statement cannot begin to claim. I remember my RegEx days back in the
mid-to-late 1980's when we were using UNIX at work... it was relatively easy
to generate the necessary RegEx statements, but if you looked at them an
hour later, you would not recognize what they were supposed to do nor figure
out how it was doing it... Regular Expressions are that cryptic to read
(well, at least they were to me).

Since you liked that example of using Like, perhaps you would find these
past offerings of mine of interest as well.

http://www.thecodecage.com/forumz/m...ing/204238-check-numeric-char.html#post729473

http://spreadsheetpage.com/index.php/tip/is_a_particular_word_contained_in_a_text_sring/

For that second link, look at the UPDATE section toward the bottom of the
webpage. That second link takes you to the noted Excel author John
Walkenbach's blog site; what I am particularly proud of with respect to my
code posted there is the reaction John posted in this blog article in
response to my offering it to him...

http://spreadsheetpage.com/index.php/blog/improving_a_function/

Oh, and if you are interested, here is a link to an Excel formula I posted
at a blog site which does the same thing as my code at the Walkenbach site
does...

http://www.get-digital-help.com/200...ring-without-using-vba-in-excel/#comment-1536

Rick Rothstein (MVP - Excel)

 

[GS]

Rick Rothstein explained :

Just so one reading this thread gets confused, you have a typo above... there
should not be any parentheses shown following the keyword "Like" as it is an
operator, not a function.

As for the Like operator itself... I really love it... it can make some
cumbersome text expression testing much easier. Not quite a Regular
Expression parser (actually, not even close to being one), yet it offers
simple, and fairly readable, parsing syntax, something a Regular Expression
statement cannot begin to claim. I remember my RegEx days back in the
mid-to-late 1980's when we were using UNIX at work... it was relatively easy
to generate the necessary RegEx statements, but if you looked at them an hour
later, you would not recognize what they were supposed to do nor figure out
how it was doing it... Regular Expressions are that cryptic to read (well, at
least they were to me).

Since you liked that example of using Like, perhaps you would find these past
offerings of mine of interest as well.

http://www.thecodecage.com/forumz/m...ing/204238-check-numeric-char.html#post729473

http://spreadsheetpage.com/index.php/tip/is_a_particular_word_contained_in_a_text_sring/

For that second link, look at the UPDATE section toward the bottom of the
webpage. That second link takes you to the noted Excel author John
Walkenbach's blog site; what I am particularly proud of with respect to my
code posted there is the reaction John posted in this blog article in
response to my offering it to him...

I recall reading his comments about that, but it was some time ago.
-Worth revisiting for sure...

http://spreadsheetpage.com/index.php/blog/improving_a_function/

Oh, and if you are interested, here is a link to an Excel formula I posted at
a blog site which does the same thing as my code at the Walkenbach site
does...

http://www.get-digital-help.com/200...ring-without-using-vba-in-excel/#comment-1536

Rick Rothstein (MVP - Excel)

I'll follow up these links for sure. Thanks...

 

[GS]

As for the Like operator itself... I really love it... it can make some

cumbersome text expression testing much easier. Not quite a Regular
Expression parser (actually, not even close to being one), yet it offers
simple, and fairly readable, parsing syntax, something a Regular Expression
statement cannot begin to claim. I remember my RegEx days back in the
mid-to-late 1980's when we were using UNIX at work... it was relatively easy
to generate the necessary RegEx statements, but if you looked at them an hour
later, you would not recognize what they were supposed to do nor figure out
how it was doing it... Regular Expressions are that cryptic to read (well, at
least they were to me).

Yeah, I've never been able to make sense out of any RegEx stuff I've

Since you liked that example of using Like, perhaps you would find these past
offerings of mine of interest as well.

http://www.thecodecage.com/forumz/m...ing/204238-check-numeric-char.html#post729473

Nice! I added these two to my mNumberTools.bas. I already use filter
functions I adapted from Francesco Balena samples, but those are more
complex than your offerings here. -Thanks...

http://spreadsheetpage.com/index.php/tip/is_a_particular_word_contained_in_a_text_sring/

For that second link, look at the UPDATE section toward the bottom of the
webpage. That second link takes you to the noted Excel author John
Walkenbach's blog site; what I am particularly proud of with respect to my
code posted there is the reaction John posted in this blog article in
response to my offering it to him...

http://spreadsheetpage.com/index.php/blog/improving_a_function/

Yep, that's what I remember reading while searching source for
something else. In fact, it might have been due to following a link
posted by you elsewhere (come to think of it!). -Something to do with
using Replace().

Oh, and if you are interested, here is a link to an Excel formula I posted at
a blog site which does the same thing as my code at the Walkenbach site
does...

http://www.get-digital-help.com/200...ring-without-using-vba-in-excel/#comment-1536

Nice! I added this to my mTextTools.bas

Rick Rothstein (MVP - Excel)

Just want you to know I really appreciate all the time and effort you
put into your posts. -Amplifies the 'V' in MVP many fold!

 

[Rick Rothstein]

Just want you to know I really appreciate all the time and effort

you put into your posts. -Amplifies the 'V' in MVP many fold!

Thank you very much for saying that... I really appreciate it.

Rick Rothstein (MVP - Excel)