info
Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
Formatting Postcodes in VBA (Bob Philips, Myrna Larson + Jamie Collins?)
83 views
Skip to first unread message
Scott
Mar 18, 2005, 5:07:49 AM3/18/05
to
I have been using the code below which is a
very slight adaptation of Myrna's original recommendation. As Jamie,
kindly pointed out there are 8 exceptions to the UK Postcode system which start
with just one alpha character! I need to be able to let these pass
through, so basically I need to allow both the following codes...
"[A-Z][A-Z]## #[A-Z][A-Z]"
and
"[A-Z]## #[A-Z][A-Z]"
The 8 Codes that break the rule a begin with the
following...
B - Birmingham
E - East London
G - Glasgow
L - Liverpool
M - Manchester
N - North London
S - Sheffield
W - West London
Hope this makes sense? Maybe once they have
put the postcode in maybe a dialog box can confirm that the address is indeed
"Manchester?" for example...
One more point I need addressing is that the first
part of the postcode is sometimes a single figure. I will need for the
code to put in a 0(zero) to cover this... For example their post code
maybe SW4 2AP I need the program to realise that in order to format correctly it
needs to add a 0 i.e. the correct results would be SW04 2AP. This is due
to the users only putting it in lazily and not fully understanding the postal
coding system.
Private Sub Worksheet_Change(ByVal Target
As Range)
Dim X As String
Dim X As String
On Error GoTo
ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("F2:F25000")) Is Nothing Then
With Target
X = UCase$(.Value)
If X Like "[A-Z][A-Z]0# #[A-Z][A-Z]" Then
'it's OK as is
ElseIf X Like "[A-Z][A-Z]0##[A-Z][A-Z]" Then
X = Left$(X, 4) & " " & Right$(X, 3)
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value = X
End With
End If
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("F2:F25000")) Is Nothing Then
With Target
X = UCase$(.Value)
If X Like "[A-Z][A-Z]0# #[A-Z][A-Z]" Then
'it's OK as is
ElseIf X Like "[A-Z][A-Z]0##[A-Z][A-Z]" Then
X = Left$(X, 4) & " " & Right$(X, 3)
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value = X
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
Application.EnableEvents = True
End Sub
Hope you guys or somebody else can help me on this
one. I'm more used to using vb.net and VBA is turning me around and I
don't want to conflict my thoughts.
Scott
Bob Phillips
Mar 18, 2005, 6:42:58 AM3/18/05
to
Somebody has been messing with the code
:-)
This took more effort than I expected, but it
works with my testing, I expect yours to be better
Private Sub Worksheet_Change(ByVal Target As
Range)
Const kCities As String = "BEGLMNSW"
Dim sCode As String
Dim sExceptions
Dim iPos As Long
Dim sCode As String
Dim sExceptions
Dim iPos As Long
sExceptions =
Array("Birmingham", "East London", "Glasgow", "Liverpool",
_
"Manchester", "North London", "Sheffield", "West London")
"Manchester", "North London", "Sheffield", "West London")
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("F2:F25000")) Is Nothing Then
With Target
sCode =
UCase$(.Value)
'Sort out the embedded space
If (sCode Like "[A-Z][A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z][A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 4) & " " & Right$(sCode, Len(sCode) - 4)
ElseIf (sCode Like "[A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 3) & " " & Right$(sCode, Len(sCode) - 3)
End If
'Sort out the leading zero
If sCode Like "[A-Z][A-Z]# #[A-Z][A-Z]" Then
sCode = Left$(sCode, 2) & "0" & Right$(sCode, Len(sCode) - 2)
ElseIf (sCode Like "[A-Z]# #[A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 1) & "0" & Right$(sCode, Len(sCode) - 1)
End If
'test for major cities
If (sCode Like "[A-Z]## #[A-Z][A-Z]" Or _
sCode Like "[A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z]## [A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
'Major city code - need to confirm OK
iPos = InStr(1, kCities, Left(sCode, 1))
If iPos > 0 Then
If MsgBox("Can you confirm that " & sCode & " is a " & vbCrLf & _
sExceptions(iPos - 1) & " postcode", vbYesNo, "POstCodes") = vbNo Then
'Sort out the embedded space
If (sCode Like "[A-Z][A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z][A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 4) & " " & Right$(sCode, Len(sCode) - 4)
ElseIf (sCode Like "[A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 3) & " " & Right$(sCode, Len(sCode) - 3)
End If
'Sort out the leading zero
If sCode Like "[A-Z][A-Z]# #[A-Z][A-Z]" Then
sCode = Left$(sCode, 2) & "0" & Right$(sCode, Len(sCode) - 2)
ElseIf (sCode Like "[A-Z]# #[A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
sCode = Left$(sCode, 1) & "0" & Right$(sCode, Len(sCode) - 1)
End If
'test for major cities
If (sCode Like "[A-Z]## #[A-Z][A-Z]" Or _
sCode Like "[A-Z]###[A-Z][A-Z]" Or _
sCode Like "[A-Z]## [A-Z][A-Z]" Or _
sCode Like "[A-Z]##[A-Z][A-Z]") Then
'Major city code - need to confirm OK
iPos = InStr(1, kCities, Left(sCode, 1))
If iPos > 0 Then
If MsgBox("Can you confirm that " & sCode & " is a " & vbCrLf & _
sExceptions(iPos - 1) & " postcode", vbYesNo, "POstCodes") = vbNo Then
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
End
If
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
End If
End If
'Now a final check
If (sCode Like "[A-Z][A-Z]## #[A-Z][A-Z]" Or _
sCode Like "[A-Z]## #[A-Z][A-Z]") Then
'it's all ok
End If
'Now a final check
If (sCode Like "[A-Z][A-Z]## #[A-Z][A-Z]" Or _
sCode Like "[A-Z]## #[A-Z][A-Z]") Then
'it's all ok
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value
= sCode
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
--
HTH
RP
(remove nothere from the email address if mailing direct)
(remove nothere from the email address if mailing direct)
"Scott" <sjs...@btinternet.com> wrote in message news:VLx_d.1379$MO6...@newsfe2-gui.ntli.net...
Bob Phillips
Mar 18, 2005, 7:46:05 AM3/18/05
to
Couple of problem(ettes) with that code, so I
played with it some more
Private Sub Worksheet_Change(ByVal Target As
Range)
Const kRange As String = "F2:F5000"
Const pcCityCodes As String = "BEGLMNSW"
Const pcNoSpaceZero1 As String = "[A-Z][A-Z]##[A-Z][A-Z]"
Const pcNoSpaceZero2 As String = "[A-Z]##[A-Z][A-Z]"
Const pcNoSpace1 As String = "[A-Z][A-Z]###[A-Z][A-Z]"
Const pcNospace2 As String = "[A-Z]###[A-Z][A-Z]"
Const pcNoZero1 As String = "[A-Z][A-Z]# #[A-Z][A-Z]"
Const pcNoZero2 As String = "[A-Z]# #[A-Z][A-Z]"
Const pcMajorCity As String = "[A-Z]## #[A-Z][A-Z]"
Const pcValid1 As String = "[A-Z][A-Z]## #[A-Z][A-Z]"
Const pcValid2 As String = "[A-Z]## #[A-Z][A-Z]"
Const pcCities As String = "Birmingham,East London,Glasgow,Liverpool,Manchester,North London,Sheffield,West London"
Dim sCode As String
Dim aryCities
Dim iPos As Long
Const pcCityCodes As String = "BEGLMNSW"
Const pcNoSpaceZero1 As String = "[A-Z][A-Z]##[A-Z][A-Z]"
Const pcNoSpaceZero2 As String = "[A-Z]##[A-Z][A-Z]"
Const pcNoSpace1 As String = "[A-Z][A-Z]###[A-Z][A-Z]"
Const pcNospace2 As String = "[A-Z]###[A-Z][A-Z]"
Const pcNoZero1 As String = "[A-Z][A-Z]# #[A-Z][A-Z]"
Const pcNoZero2 As String = "[A-Z]# #[A-Z][A-Z]"
Const pcMajorCity As String = "[A-Z]## #[A-Z][A-Z]"
Const pcValid1 As String = "[A-Z][A-Z]## #[A-Z][A-Z]"
Const pcValid2 As String = "[A-Z]## #[A-Z][A-Z]"
Const pcCities As String = "Birmingham,East London,Glasgow,Liverpool,Manchester,North London,Sheffield,West London"
Dim sCode As String
Dim aryCities
Dim iPos As Long
aryCities = Split(pcCities,
",")
On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target,
Me.Range(kRange)) Is Nothing Then
With Target
sCode = UCase$(.Value)
'Missing
space and leading
zero
If sCode Like pcNoSpaceZero1 Then
sCode = Left$(sCode, 2) & "0" & Mid(sCode, 3, 1) & " " & Right$(sCode, Len(sCode) - 3)
ElseIf sCode Like pcNoSpaceZero2 Then
sCode = Left$(sCode, 1) & "0" & Mid(sCode, 2, 1) & " " & Right$(sCode, Len(sCode) - 2)
End If
'Missing zero only
If sCode Like pcNoZero1 Then
If sCode Like pcNoSpaceZero1 Then
sCode = Left$(sCode, 2) & "0" & Mid(sCode, 3, 1) & " " & Right$(sCode, Len(sCode) - 3)
ElseIf sCode Like pcNoSpaceZero2 Then
sCode = Left$(sCode, 1) & "0" & Mid(sCode, 2, 1) & " " & Right$(sCode, Len(sCode) - 2)
End If
'Missing zero only
If sCode Like pcNoZero1 Then
sCode = Left$(sCode, 2) & "0" & Right$(sCode, Len(sCode) - 2)
ElseIf
sCode Like pcNoZero2
Then
sCode = Left$(sCode, 1) & "0" & Right$(sCode, Len(sCode) - 1)
End If
'Missing
space only
If sCode Like pcNoSpace1 Then
If sCode Like pcNoSpace1 Then
sCode = Left$(sCode, 4) & " " & Right$(sCode, Len(sCode) - 4)
ElseIf
sCode Like pcNospace2
Then
sCode = Left$(sCode, 3) & " " & Right$(sCode, Len(sCode) - 3)
End If
'test for
major
cities
If sCode Like pcMajorCity Then
If sCode Like pcMajorCity Then
'Major city code - need to confirm OK
iPos = InStr(1, pcCityCodes, Left(sCode,
1))
If iPos > 0 Then
If MsgBox("Can you confirm that " & sCode & " is a " & vbCrLf & _
aryCities(iPos - 1) & " postcode", vbYesNo, "PostCodes") = vbNo
Then
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes Error!"
End If
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes Error!"
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes Error!"
End If
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes Error!"
End If
End If
'Now a final check
If
(sCode Like pcValid1 Or sCode Like pcValid2)
Then
'it's all ok
Else
MsgBox "Incorrect format: AA0# #AA", vbOKOnly, "PostCodes
Error!"
'leave the string as-is so they can correct without
'retyping the whole thing
End If
.Value = sCode
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
#If VBA6
Then
#Else
'-----------------------------------------------------------------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------------------------------------------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues
#Else
'-----------------------------------------------------------------
Function Split(Text As String, _
Optional Delimiter As String = ",") As Variant
'-----------------------------------------------------------------
Dim i As Long
Dim sFormula As String
Dim aryEval
Dim aryValues
If Delimiter = vbNullChar
Then
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If
sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next
Delimiter = Chr(7)
Text = Replace(Text, vbNullChar, Delimiter)
End If
sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}"
aryEval = Evaluate(sFormula)
ReDim aryValues(0 To UBound(aryEval) - 1)
For i = 0 To UBound(aryValues)
aryValues(i) = aryEval(i + 1)
Next
Split = aryValues
End Function
#End If
#End If
--
HTH
RP
(remove nothere from the email address if mailing direct)
(remove nothere from the email address if mailing direct)
"Bob Phillips" <bob.ph...@notheretiscali.co.uk> wrote in message news:OrJgl%236KF...@TK2MSFTNGP12.phx.gbl...
Jamie Collins
Mar 18, 2005, 8:24:02 AM3/18/05
to
Bob Phillips wrote:
> Couple of problem(ettes) with that code, so I played with it some
more
Bob, Sorry, I didn't know this was a programming question...
Scott, The rules are even more complex than you stated <g>.
Considered setting a reference to Microsoft VBScript Regular
Expressions 5.5 and using a more capable regular expression (the one
from my original post was intended for use in a SQL Server/Jet CHECK
constraint, which support only simple pattern matching, and does not do
the job anyhow). As with all things standardised, the 'not invented
here' mentality should be resisted. Here's somewhere to start looking:
http://regexlib.com/Search.aspx?k=uk%20postcode
Jamie.
--
Scott
Mar 18, 2005, 8:31:07 AM3/18/05
to
I have come across a one similar to this SW15A 4PP, but only once and from
that link you gave in the last post I noticed there is another. But I must
admit these must be very, very rare. I guess it would make the coding
infinitely more difficult if these 2 other variations are added. Must give
credit to Bob, as he has quite quickly generated some code.
that link you gave in the last post I noticed there is another. But I must
admit these must be very, very rare. I guess it would make the coding
infinitely more difficult if these 2 other variations are added. Must give
credit to Bob, as he has quite quickly generated some code.
Point taken though...
Scott
"Jamie Collins" <jamiec...@xsmail.com> wrote in message
news:1111152242....@f14g2000cwb.googlegroups.com...
Jamie Collins
Mar 18, 2005, 9:06:44 AM3/18/05
to
Scott wrote:
> > As with all things standardised, the 'not invented
> > here' mentality should be resisted. Here's somewhere to start
looking:
> >
> > http://regexlib.com/Search.aspx?k=uk%20postcode
> >
> I have come across a one similar to this SW15A 4PP, but only once and
from
> that link you gave in the last post I noticed there is another. But
I must
> admit these must be very, very rare. I guess it would make the
coding
> infinitely more difficult if these 2 other variations are added.> >
from
> that link you gave in the last post I noticed there is another. But
I must
> admit these must be very, very rare. I guess it would make the
coding
> infinitely more difficult if these 2 other variations are added.> >
Did you take a look at the link to regexlib? There seem to be a range
of extremes catered for, from
^[a-zA-Z]{1,2}[0-9][0-9A-Za-z]{0,1} {0,1}[0-9][A-Za-z]{2}$
to
^((([A-PR-UWYZ])([0-9][0-9A-HJKS-UW]?))|(([A-PR-UWYZ][A-HK-Y
])([0-9][0-9ABEHMNPRV-Y]?))\s{0,2}(([0-9])([ABD-HJLNP-UW-Z])
([ABD-HJLNP-UW-Z])))|(((GI)(R))\s{0,2}((0)(A)(A)))$
I'd hesitate to endorse one myself, though. Pick one that looks good
enough and do some testing.
BTW your client may have some input to this e.g. I've seen an Inland
Revenue regex for postcode that was fairly simple and if it'd good
enough for them...
Jamie.
--
Bob Phillips
Mar 18, 2005, 9:19:21 AM3/18/05
to
Nit if you use RegExp. They make such parsing simply (as long as you can
understand the expresssion :-))
understand the expresssion :-))
--
HTH
RP
(remove nothere from the email address if mailing direct)
"Scott" <sjs...@btinternet.com> wrote in message
news:vKA_d.486$yW1...@newsfe4-gui.ntli.net...
Bob Phillips
Mar 18, 2005, 12:34:36 PM3/18/05
to
Actually considering your requirements, add the space, and cater for 1 digit
town numbers (add a 0), I don't think Regular Expressions save you much.
town numbers (add a 0), I don't think Regular Expressions save you much.
If the code is correct input, there are only 2 patterns to match in the
code that I gave
[A-Z][A-Z]## #[A-Z][A-Z]
[A-Z]## #[A-Z][A-Z]
so the saving on RegEx is minimal. All of the other patterns I gave are for
your particular format/output requirements.
I also tried some of the patterns provided in the link that Jamie gave, and
none was totally accurate in your definition of a valid postcode. I am sure
that they can be adapted to be 'perfect', but I don't feel confident enough
with patterns as of yet.
--
HTH
RP
(remove nothere from the email address if mailing direct)
"Bob Phillips" <bob.ph...@notheretiscali.co.uk> wrote in message
news:%23uuP8V8...@TK2MSFTNGP12.phx.gbl...
0 new messages