Slight issue with a VBScript

T

trafficzombie

Board Regular
Joined
Sep 9, 2011
Messages
63
I have the following code to check valid formats of UK psot codes

I have had this as a query a few times and thougth it was now 100% but 1 last issue has arrisen

When a post code shows as VALID for example B17 7AA

But if you add another digit at the end B17 7AAA - it still shows as VALID

It just appears to be the 5 and 6 digit post codes it does this on

The 7 digit ones show as INVALID - when there is an extra digit

Can anyone help

Code: 
Public Function IsUKPostCode(strInput As String)
'Uses a regular expression to validate the format of a postcode.
'May require WindowsScripting 5.6 - downloadable from microsoft.com
Dim RgExp As Variant
'Create the regular expression object
Set RgExp = CreateObject("VBScript.RegExp")
'Clear the function value
IsUKPostCode = ""
'Check we have value to test
If strInput = "" Then
IsUKPostCode = "Not Supplied"
Exit Function
End If
strInput = UCase(strInput)
'This is the ridiculously complex expression that validates the postcode
RgExp.Pattern = "(?:(?:A[BL]|B[ABDHLNRST]?|" _
& "C[ABFHMORTVW]|D[ADEGHLNTY]|E[CHNX]?|F[KY]|G[LUY]?|" _
& "H[ADGPRSUX]|I[GMPV]|JE|K[ATWY]|L[ADELNSU]?|M[EKL]?|" _
& "N[EGNPRW]?|O[LX]|P[AEHLOR]|R[GHM]|S[AEGKLMNOPRSTWY]?|" _
& "T[ADFNQRSW]|UB|W[ACDFNRSV]?|YO|ZE)" _
& "\d(?:\d|[A-Z])? \d[A-Z]{2})"
'Does the fed in string match the pattern?
If RgExp.test(strInput) = True And Len(strInput) <= 8 Then
strCheck = strInput
'Clean out any redundant characters - whilst most of these don't make sense
'I've seen them all in postcodes before!
strInput = Replace(strInput, "_", "")
strInput = Replace(strInput, ",", "")
strInput = Replace(strInput, "+", "")
strInput = Replace(strInput, "-", "")
strInput = Replace(strInput, ":", "")
strInput = Replace(strInput, "=", "")
strInput = Replace(strInput, "/", "")
strInput = Replace(strInput, "*", "")
strInput = Replace(strInput, "?", "")
strInput = Replace(strInput, ".", "")
strInput = Replace(strInput, "!", "")
strInput = Replace(strInput, "£", "")
strInput = Replace(strInput, "$", "")
strInput = Replace(strInput, "%", "")
strInput = Replace(strInput, "^", "")
strInput = Replace(strInput, "&", "")
strInput = Replace(strInput, "(", "")
strInput = Replace(strInput, ")", "")
If strCheck = strInput Then
    IsUKPostCode = "Valid"
Else
    IsUKPostCode = strInput
End If
Else
'------------------------------
'Try to make a correct postcode
'------------------------------
'Despace & uppercase
strInput = UCase(Replace(strInput, " ", ""))
'Clean out any redundant characters - whilst most of these don't make sense
'I've seen them all in postcodes before!
strInput = Replace(strInput, "_", "")
strInput = Replace(strInput, ",", "")
strInput = Replace(strInput, "+", "")
strInput = Replace(strInput, "-", "")
strInput = Replace(strInput, ":", "")
strInput = Replace(strInput, "=", "")
strInput = Replace(strInput, "/", "")
strInput = Replace(strInput, "*", "")
strInput = Replace(strInput, "?", "")
strInput = Replace(strInput, ".", "")
strInput = Replace(strInput, "!", "")
strInput = Replace(strInput, "£", "")
strInput = Replace(strInput, "$", "")
strInput = Replace(strInput, "%", "")
strInput = Replace(strInput, "^", "")
strInput = Replace(strInput, "&", "")
strInput = Replace(strInput, "(", "")
strInput = Replace(strInput, ")", "")
'---------------------------------------------------------------------------
'Check the string length again to make sure we've not got a "???" type entry
'---------------------------------------------------------------------------
        If Len(strInput) = 0 Then
        IsUKPostCode = "Not Supplied"
        Exit Function
        ElseIf IsNumeric(strInput) Then
        IsUKPostCode = "All Numbers"
        Exit Function
        ElseIf Len(strInput) < 5 Then
        IsUKPostCode = "Too Short"
        Exit Function
        ElseIf Len(strInput) > 8 Then
        IsUKPostCode = "Too Long"
        Exit Function
        End If
        'Check for and correct substituted O (alpha) for 0 (numeric) at position len - 2
        If Mid(strInput, Len(strInput) - 2, 1) = "O" Then strInput = _
        Left(strInput, Len(strInput) - 3) & "0" & Right(strInput, 2)
        'Check for and correct substituted 0 (numeric) for O (alpha) at position 1 or 2
        If Mid(strInput, 2, 1) = "0" Then strInput = _
        Left(strInput, 1) & "O" & Right(strInput, Len(strInput) - 2)
        If Left(strInput, 1) = "0" Then strInput = _
        "O" & Right(strInput, Len(strInput) - 1)
        'Check for and correct substituted lowercase l for 1 at position len - 2
        If Mid(strInput, Len(strInput) - 2, 1) = "l" Then strInput = _
        Left(strInput, Len(strInput) - 3) & "1" & Right(strInput, 2)
        'Check for and correct substituted lowercase l for 1 at position 3
        If Mid(strInput, 3, 1) = "l" Then strInput = _
        Left(strInput, 2) & "1" & Right(strInput, Len(strInput) - 3)
        'Check for and correct substituted S for 5 at position len - 3
        If Mid(strInput, Len(strInput) - 3, 1) = "S" Then strInput = _
        Left(strInput, Len(strInput) - 3) & "5" & Right(strInput, 2)
        'Two possible lengths for a valid UK postcode
        Select Case Len(strInput)
        Case 6
        If RgExp.test(Left(strInput, 3) & " " & Right(strInput, 3)) = True Then
        'Format should be ?## #?? or ??# #??
        IsUKPostCode = Left(strInput, 3) & " " & Right(strInput, 3)
        Else
        IsUKPostCode = "Invalid"
        End If
        Case 7
        If RgExp.test(Left(strInput, 4) & " " & Right(strInput, 3)) = True Then
        'Format is ??## #?? or ?#?# #??
        IsUKPostCode = Left(strInput, 4) & " " & Right(strInput, 3)
        Else
        IsUKPostCode = "Invalid"
        End If
        Case Else
        IsUKPostCode = "Invalid"
        End Select
        End If
        End Function
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
Here is a function (it can be used as a UDF, user defined function, also) that I have posted in the past (under a much longer name) which will check if the string passed into it could be a valid UK Post Code, but be aware, it does not check to make sure that post code is currently in use, only that it is of the proper shape and composition to be a post code....

Code: 
Function IsPostCode(ByVal PostCode As String) As Boolean
  Dim Parts() As String
  PostCode = UCase$(PostCode)
  Parts = Split(PostCode)
  IsPostCode = (PostCode = "GIR 0AA" Or PostCode = "SAN TA1" Or _
               (Parts(1) Like "#[ABD-HJLNP-UW-Z][ABD-HJLNP-UW-Z]" And _
               (Parts(0) Like "[A-PR-UWYZ]#" Or _
                Parts(0) Like "[A-PR-UWYZ]#[0-9A-HJKSTUW]" Or _
                Parts(0) Like "[A-PR-UWYZ][A-HK-Y]#" Or _
                Parts(0) Like "[A-PR-UWYZ][A-HK-Y]#[0-9ABEHMNPRVWXY]")))
End Function
I don't know about those "redundant characters" you mentioned... they are not allowed according to the definitions I have read on UK Post Codes. My suggestion, if you really want to allow them, would be to create a separate "CleanPotentionUKPostCodes" function to remove them before passing them into my function above. I would do it that way instead of modifying the function above so that the function above remains true to the official definition of UK Post Code "shaping".
 
Last edited:
Upvote 0
Hi,

Not sure if this is much help to you but I'll tell you anyways.

for example if you have all PostCodes in Column A, put this formula in column B.

Code: 
=TRIM(LEFT(A1,LEN(A1)-3))&" "&RIGHT(A1,3)

It puts UK postcodes into the correct format. As mentioned by Rick, it only puts the postcodes into the correct format but doesnt check if they exist.
 
Last edited:
Upvote 0
Rick Rothstein said:
Here is a function (it can be used as a UDF, user defined function, also) that I have posted in the past (under a much longer name) which will check if the string passed into it could be a valid UK Post Code, but be aware, it does not check to make sure that post code is currently in use, only that it is of the proper shape and composition to be a post code....

Code: 
Function IsPostCode(ByVal PostCode As String) As Boolean
  Dim Parts() As String
  PostCode = UCase$(PostCode)
  Parts = Split(PostCode)
  IsPostCode = (PostCode = "GIR 0AA" Or PostCode = "SAN TA1" Or _
               (Parts(1) Like "#[ABD-HJLNP-UW-Z][ABD-HJLNP-UW-Z]" And _
               (Parts(0) Like "[A-PR-UWYZ]#" Or _
                Parts(0) Like "[A-PR-UWYZ]#[0-9A-HJKSTUW]" Or _
                Parts(0) Like "[A-PR-UWYZ][A-HK-Y]#" Or _
                Parts(0) Like "[A-PR-UWYZ][A-HK-Y]#[0-9ABEHMNPRVWXY]")))
End Function
I don't know about those "redundant characters" you mentioned... they are not allowed according to the definitions I have read on UK Post Codes. My suggestion, if you really want to allow them, would be to create a separate "CleanPotentionUKPostCodes" function to remove them before passing them into my function above. I would do it that way instead of modifying the function above so that the function above remains true to the official definition of UK Post Code "shaping".
Click to expand...

Thank you for this, can I incorporate this in to the VBS I have mentioned above?

As the above code in the original listing sorts out the 7 digit post codes with an extra digit, but not the 5 or 6 digit ones. Does this make sense?
 
Upvote 0
Rick Rothstein said:
...but be aware, it does not check to make sure that post code is currently in use, only that it is of the proper shape and composition to be a post code....
Click to expand...
If, however, you do want a function that checks if the Post Code is valid and in use, then you can start with this (which was posted by Bob Phillips and was valid as of 3+ years ago)...

Code: 
Function ValidPostCode(ByVal PostCode As String) As Boolean
Dim Parts() As String
    PostCode = UCase$(PostCode)
    Parts = Split(PostCode, " ")
    'check the two abnormal possibilities
    If PostCode = "GIR 0AA" Or PostCode = "SAN TA1" Then
        ValidPostCode = True
    'check second part doesn't use Q, V or X in first letter
    ElseIf Parts(1) Like "#[ABD-HJLNP-UW-Z][ABD-HJLNP-UW-Z]" Then
        'depending upon first letter, validate first part
        Select Case Left$(Parts(0), 1)
            Case "A": ValidPostCode = Parts(0) Like "A[0-9BL]#*"
            Case "B": ValidPostCode = Parts(0) Like "B[0-9ABDHLNRST]#*"
            Case "C": ValidPostCode = Parts(0) Like "C[0-9ABFHMORTVW]#*"
            Case "D": ValidPostCode = Parts(0) Like "D[0-9ADEGHLNTY]#*"
            Case "E": ValidPostCode = Parts(0) Like "E[0-9CHNX]#*"
            Case "F": ValidPostCode = Parts(0) Like "F[0-9KY]#*"
            Case "G": ValidPostCode = Parts(0) Like "G[0-9LU]#*"
            Case "H": ValidPostCode = Parts(0) Like "H[0-9ADGPRSUX]#*"
            Case "I": ValidPostCode = Parts(0) Like "I[0-9GPV]#*"
            Case "J": ValidPostCode = Parts(0) Like "K[0-9ATWY]#*"
            Case "K": ValidPostCode = Parts(0) Like "J##"
            Case "L": ValidPostCode = Parts(0) Like "L[0-9ADELNSU]#*"
            Case "M": ValidPostCode = Parts(0) Like "M[0-9EKL]#*"
            Case "N": ValidPostCode = Parts(0) Like "N[0-9EGNPRW]#*"
            Case "O": ValidPostCode = Parts(0) Like "O[0-9LX]#*"
            Case "P": ValidPostCode = Parts(0) Like "P[0-9AEHLOR]#*"
            Case "R": ValidPostCode = Parts(0) Like "R[0-9GHM]#*"
            Case "R": ValidPostCode = Parts(0) Like "S[0-9AEGKLMNOPRSTWY]#*"
            Case "T": ValidPostCode = Parts(0) Like "T[0-9ADFNQRSW]#*"
            Case "U": ValidPostCode = Parts(0) Like "U[0-9B]#*"
            Case "W": ValidPostCode = Parts(0) Like "W[0-9ACDFNRSV]#*"
            Case "Y": ValidPostCode = Parts(0) Like "Y[0-9O]#*"
            Case "Z": ValidPostCode = Parts(0) Like "Z[0-9E]#*"
        End Select
    End If
End Function
The reason I mention the "3+ years ago" is if any new post codes were placed into service, or if any post codes were removed, across that time span, then the above function would need to be modified to account for those changes. This also points out the weakness in this function's approach... it needs to always be monitored and updated. This is why I opted for the "proper shape" function I posted earlier... if meets the rules for post codes and, in doing so, is immune to changes in post code activation/deactivation... you just don't know if the post code is "in use" or not.
 
Upvote 0
trafficzombie said:
Thank you for this, can I incorporate this in to the VBS I have mentioned above?

As the above code in the original listing sorts out the 7 digit post codes with an extra digit, but not the 5 or 6 digit ones. Does this make sense?
Click to expand...
I don't know... the code you posted is too long for me to wrap my head around given that it makes heavy use Regular Expressions (which I haven't used since the mid to late 1980s) whereas my code uses straight, native VB coding. I'm sure you can pull out the parts of your code that you need and then when you get to the part where you need to check if the post code is valid or not, just make a call to my function for that part of the operation.
 
Upvote 0
Confusing now

So the code you put down will check the format?

so for example

M1 3RT
SL1 3GF
MK14 3RT

If there is no gap for example MK143RT

What will happen with this and also if an extra digit or symbol at the end for example MK14 3RTT or MK14 3RT*

The code I have to the top works perfectly apart from 5 or 6 digit post codes with an extra at the end which is obviously incorrect (M1 3RTY or M26 3SFG)

I don't need it to check that the post code is actually a valid code, rather it is a valid format
 
Upvote 0
trafficzombie said:
So the code you put down will check the format?

so for example

M1 3RT
SL1 3GF
MK14 3RT

If there is no gap for example MK143RT

What will happen with this and also if an extra digit or symbol at the end for example MK14 3RTT or MK14 3RT*

The code I have to the top works perfectly apart from 5 or 6 digit post codes with an extra at the end which is obviously incorrect (M1 3RTY or M26 3SFG)

I don't need it to check that the post code is actually a valid code, rather it is a valid format
Click to expand...

The code I posted has a slight flaw in that it did not handle the missing gap situation correctly, but I fixed that in the code below. As for your questions.... yes, the code below (modified to handle the missing gap) tests that the passed in text string is of the proper format (that is, shape, size and composition of letters and numbers in the proper positions allowed for them) in order to be a UK Post Code. As I said originally, though, it does not allow for those, as you call them, redundant characters... if one or more of them are in the text string passed into my function, the function will return False for that text string, so if you want to allow for them to be there, you will need a separate function to clean them out of the text string before you pass it into my function.

Code: 
Function IsPostCode(ByVal PostCode As String) As Boolean
  Dim Parts() As String
  PostCode = UCase$(PostCode & " ")
  Parts = Split(PostCode)
  IsPostCode = (PostCode = "GIR 0AA" Or PostCode = "SAN TA1" Or _
               (Parts(1) Like "#[ABD-HJLNP-UW-Z][ABD-HJLNP-UW-Z]" And _
               (Parts(0) Like "[A-PR-UWYZ]#" Or _
                Parts(0) Like "[A-PR-UWYZ]#[0-9A-HJKSTUW]" Or _
                Parts(0) Like "[A-PR-UWYZ][A-HK-Y]#" Or _
                Parts(0) Like "[A-PR-UWYZ][A-HK-Y]#[0-9ABEHMNPRVWXY]")))
End Function
One other note... if the text string you pass in has leading or trailing spaces, those text strings will also generate a False return value. I was of mixed feelings whether properly formatted text with leading or trailing blanks should be allowed or not. If you want to allow them, then change this line of code...

Code: 
  PostCode = UCase$(PostCode & " ")
to this...

Code: 
  PostCode = UCase$(Trim(PostCode) & " ")
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
VBA Code - Trim function
Replies
6
Views
848
Fluff
Fluff
A
  • Question
VBA for sending e-mails
Replies
5
Views
481
Micron
M
D
  • Solved
Worksheet_Change when user Drags File Handle or Copy/Paste Multiple
Replies
3
Views
391
Joe4
Joe4
E
  • Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
2K
profray
P
S
  • Question
VBA to ignore certain MAC Address values but process all others
Replies
1
Views
193
myall_blues
myall_blues

Forum statistics

Threads
1,215,014
Messages
6,122,697
Members
449,092
Latest member
snoom82

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top