Postcode validation VBA

[Mr.Daines]

Hello all,

I have created a postcode validation script for my userform but it always throws up the message saying Invalid postcode regardless of what postcode i enter [valid or not].

Can anyone see where i have gone wrong?

' Validates the postcode entered - Format Check
Private Function validPostcode(postCode) ' Format check
Dim valid As Boolean
Dim first As String
Dim number As String
Dim last As String
Dim poCode As String
Dim space As String
Dim i As String
Dim cha As String
' Splits the postcode into sections.
poCode = tbpostcode.Text
first = Left(poCode, 1)
number = Mid(poCode, 2, 2)
space = Mid(poCode, 4, 1)
last = Right(poCode, 3)
valid = True
' If there is data
If Not poCode = "" Then
valid = True
End If
' Checking the value of first digit
If Not frontLetter(first) Then
valid = False
End If
' Checking the second and third characters
If Not isNumeric(number) <> 7 Then
valid = False
End If
' Checks to see if there is a space
' After the fourth digit
If Not space = "" Then
valid = False
End If
' Checks that last three digits
If Not lastThree(last) Then
valid = False
End If
validPostcode = valid
' Display error if invalid postcode
If valid = False Then
MsgBox "Please enter a valid postcode", vbOKOnly
End If
End Function
 
' Function to validate the front letter of the postcode
Private Function frontLetter(s As String)
Dim ing As Integer
Dim ch As String
Dim valid As Boolean
valid = True
For ing = 1 To Len(s)
ch = Mid(s, ing, 1)
If ch < "A" Or ch > "Z" Then
valid = False
End If
Next ing
frontLetter = valid
End Function
 
' Function to validate numeric value of
' The postcode
Private Function isNumeric(s As String)
Dim ing As Integer
Dim ch As String
Dim valid As Boolean
valid = True
For ing = 1 To Len(s)
ch = Mid(s, ing, 1)
If ch < "0" Or ch > "9" Then
valid = False
End If
Next ing
isNumeric = valid
End Function
 
' Validate last three characters of postcode
Private Function lastThree(s As String)
Dim ing As Integer
Dim ch As String
Dim valid As Boolean
valid = True
For ing = 1 To Len(s)
ch = Mid(s, ing, 1)
If ch < "A" Or ch > "Z" Then
valid = False
End If
Next ing
lastThree = valid
End Function

Any help much appreciated.

 

[Mr.Daines]

As to the SuperFerret link to XLD’s code, use it in this way:

Private Sub cmdAdd_Click()
 tbpostcode.Text = UCase(tbpostcode.Text)
 If Not validPostcode(tbpostcode.Text) Then MsgBox "Wrong postcode: " & tbpostcode.Text
End Sub

I have implemented this as instructed and copied/pasted XLD's code into module2.

When testing the user form and placing 111 or something similar into the tbpostcode box i get subscript out of range. Do i need to modify anything in XLD's example code as i have left this untouched.

Thanks a lot for everyones help so far.

 

[ZVI]

After the code line: Sections = Split(PostCode)
add this line: If UBound(Sections) <> 1 Then Exit Function

 

[Mr.Daines]

After the code line: Sections = Split(PostCode)
add this line: If UBound(Sections) <> 1 Then Exit Function

IF(problem="yes","Ask ZVI","")

Thank you so much.

This is now working as it should.

Second question if i may; how would i write the code for the tbNumber box to check that the number is entered to 11 characters and is numeric.

Thanks again

 

[Mr.Daines]

IF(problem="yes","Ask ZVI","")

Thank you so much.

This is now working as it should.

Second question if i may; how would i write the code for the tbNumber box to check that the number is entered to 11 characters and is numeric.

Thanks again

This is what i have so far.

If Not isNumeric(Me.tbNumber.Value) Then
  Me.tbNumber.SetFocus
  MsgBox "Please enter clients primary contact number", , "Essential!"
  Exit Sub
End If

 

[ZVI]

Something like this:
If Len(Replace(tbNumber, " ", "")) <> 11 Or Val(tbNumber) <> tbNumber Then ...

 

[Mr.Daines]

IF(problem="yes","Ask ZVI","")

Thank you so much.

This is now working as it should.

Second question if i may; how would i write the code for the tbNumber box to check that the number is entered to 11 characters and is numeric.

Thanks again

Agggghhhh....

Just been testing my userform and it is now saying that all postcodes entered are wrong, i have tried sk4 2hd and ip14 4ed, i havent changed anything either....

cmdAdd_click

tbpostcode.Text = UCase(tbpostcode.Text)
  If Not ValidPostCode(tbpostcode.Text) Then
  MsgBox "Wrong postcode: " & tbpostcode.Text
  tbpostcode.SetFocus
  tbpostcode.Value = ""
  Exit Sub
End If

module2

Function ValidPostCode(ByVal PostCode As String) As Boolean
Dim Sections() As String
    PostCode = UCase$(tbpostcode)
    Sections = Split(PostCode)
    If UBound(Sections) <> 1 Then Exit Function
    If PostCode = "GIR 0AA" Or PostCode = "SAN TA1" Or _
        (Sections(1) Like "#[A-Z][A-Z]" And _
        (Sections(0) Like "[A-Z]#" Or Sections(0) Like "[A-Z]#[0-9ABCDEFGHJKSTUW]" Or _
         Sections(0) Like "[A-Z][A-Z]#" Or Sections(0) Like "[A-Z][A-Z]#[0-9ABEHMNPRVWXY]")) Then
        ValidPostCode = ((Sections(0) Like "[BEGLMSW]#*" Or _
                          Sections(0) Like "A[BL]#*" Or _
                          Sections(0) Like "B[ABDHLNRST]#*" Or _
                          Sections(0) Like "C[ABFHMORTVW]#*" Or _
                          Sections(0) Like "D[ADEGHLNTY]#*" Or _
                          Sections(0) Like "E[CHNX]#[AMNRVY]" Or _
                          Sections(0) Like "F[KY]#*" Or _
                          Sections(0) Like "G[LU]#*" Or _
                          Sections(0) Like "H[ADGPRSUX]#*" Or _
                          Sections(0) Like "I[GPV]#*" Or _
                          Sections(0) Like "K[ATWY]#*" Or _
                          Sections(0) Like "L[ADELNSU]#*" Or _
                          Sections(0) Like "M[EKL]#*" Or _
                          Sections(0) Like "N[EGNPRW]#*" Or _
                          Sections(0) Like "O[LX]#*" Or _
                          Sections(0) Like "P[AEHLOR]#*" Or _
                          Sections(0) Like "R[GHM]#*" Or _
                          Sections(0) Like "S[AEGKLMNOPRSTWY]#*" Or _
                          Sections(0) Like "T[ADFNQRSW]#*" Or _
                          Sections(0) Like "W[ACDFNRSV]#*" Or _
                          Sections(0) Like "UB#*" Or _
                          Sections(0) Like "YO#*" Or _
                          Sections(0) Like "ZE#*") And _
                          Sections(1) Like "*#[!CIKMOV][!CIKMOV]")
    Else
        ValidPostCode = False
    End If
End Function

Whats happened?

 

[Mr.Daines]

Something like this:
If Len(Replace(tbNumber, " ", "")) <> 11 Or Val(tbNumber) <> tbNumber Then ...

This has worked amazingly. Thanks.

 

[ZVI]

Whats happened?

It seems that something is wrong in your code, please debug it.
This test returns True for both cases:

Sub Test()
  Debug.Print ValidPostCode("sk4 2hd")  ' True
  Debug.Print ValidPostCode("ip14 4ed") ' True
End Sub

P.S. Should go out now, hope you will find the reason of issue

 

[ZVI]

Create new user form, place on it textbox "tbpostcode" and command button "cmdAdd".
Show the form and click cmdAdd button.
You'll see that both tests are passed successfully.

' Code of UserForm1 with "cmdAdd" command button and "tbpostcode" textbox
Private Sub cmdAdd_Click()
  
  ' TEST#1
  tbpostcode = "sk4 2hd"
  ' The line below is not required because ValidPostCode has its own Ucase convertsion
  tbpostcode = UCase(tbpostcode)
  If Not ValidPostCode(tbpostcode) Then
    tbpostcode.SetFocus
    MsgBox "<" & tbpostcode & "> is wrong postcode", vbExclamation, "Test#1"
    tbpostcode = ""
  Else
    MsgBox "<" & tbpostcode & "> is valid postcode", vbInformation, "Test#1"
  End If
  
  ' TEST#2
  tbpostcode = "ip14 4ed"
  If Not ValidPostCode(tbpostcode) Then
    tbpostcode.SetFocus
    MsgBox "<" & tbpostcode & "> is wrong postcode", vbExclamation, "Test#2"
    tbpostcode = ""
  Else
    MsgBox "<" & tbpostcode & "> is valid postcode", vbInformation, "Test#2"
  End If
  
End Sub

' XLD:2009-12-15 http://www.mrexcel.com/forum/showthread.php?t=436118
Function ValidPostCode(ByVal PostCode As String) As Boolean
  Dim Sections() As String
  PostCode = UCase$(tbpostcode)
  Sections = Split(PostCode)
  If UBound(Sections) <> 1 Then Exit Function
  If PostCode = "GIR 0AA" Or PostCode = "SAN TA1" Or _
    (Sections(1) Like "#[A-Z][A-Z]" And _
    (Sections(0) Like "[A-Z]#" Or Sections(0) Like "[A-Z]#[0-9ABCDEFGHJKSTUW]" Or _
     Sections(0) Like "[A-Z][A-Z]#" Or Sections(0) Like "[A-Z][A-Z]#[0-9ABEHMNPRVWXY]")) Then
     ValidPostCode = ((Sections(0) Like "[BEGLMSW]#*" Or _
                       Sections(0) Like "A[BL]#*" Or _
                       Sections(0) Like "B[ABDHLNRST]#*" Or _
                       Sections(0) Like "C[ABFHMORTVW]#*" Or _
                       Sections(0) Like "D[ADEGHLNTY]#*" Or _
                       Sections(0) Like "E[CHNX]#[AMNRVY]" Or _
                       Sections(0) Like "F[KY]#*" Or _
                       Sections(0) Like "G[LU]#*" Or _
                       Sections(0) Like "H[ADGPRSUX]#*" Or _
                       Sections(0) Like "I[GPV]#*" Or _
                       Sections(0) Like "K[ATWY]#*" Or _
                       Sections(0) Like "L[ADELNSU]#*" Or _
                       Sections(0) Like "M[EKL]#*" Or _
                       Sections(0) Like "N[EGNPRW]#*" Or _
                       Sections(0) Like "O[LX]#*" Or _
                       Sections(0) Like "P[AEHLOR]#*" Or _
                       Sections(0) Like "R[GHM]#*" Or _
                       Sections(0) Like "S[AEGKLMNOPRSTWY]#*" Or _
                       Sections(0) Like "T[ADFNQRSW]#*" Or _
                       Sections(0) Like "W[ACDFNRSV]#*" Or _
                       Sections(0) Like "UB#*" Or _
                       Sections(0) Like "YO#*" Or _
                       Sections(0) Like "ZE#*") And _
                       Sections(1) Like "*#[!CIKMOV][!CIKMOV]")
    Else
        ValidPostCode = False
    End If
End Function

 

[Dagonean]

I honestly don't remember where I got this from, but I've modified it a bit based on some of the countries we've been recently been shipping too, so here's my code.

Function ValidPostalCode(PostalCode As String, Country As String) As Boolean
    Dim blnIsItValid As Boolean, strTemp As String
    
    Select Case Country
        Case "US"
            If PostalCode Like "[0-9][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            ElseIf PostalCode Like "[0-9][0-9][0-9][0-9][0-9][-][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
            End If
        Case "" 'Default if the ship to country is the US
            If PostalCode Like "[0-9][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            ElseIf PostalCode Like "[0-9][0-9][0-9][0-9][0-9][-][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
            End If
        Case "CA"
            strTemp = PostalCode
            PostalCode = UCase$(strTemp)
            If PostalCode Like "[A-Z][0-9][A-Z][ ][0-9][A-Z][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
            End If
        Case "AT"
            If PostalCode Like "[0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
            End If
        Case "DE"
            If PostalCode Like "[0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
                Exit Function
            ElseIf PostalCode Like "[0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
                Exit Function
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
                Exit Function
            ElseIf PostalCode Like "[0-9][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
                Exit Function
            End If
        Case "FR"
            If PostalCode Like "[0-9][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
            End If
        Case "CH"
            If PostalCode Like "[0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
                Exit Function
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
                Exit Function
            End If
        Case "RU"
            If PostalCode Like "[0-9][0-9][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
            End If
        Case "SE"
            If PostalCode Like "[0-9][0-9][0-9][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
                Exit Function
            ElseIf PostalCode Like "[0-9][0-9][0-9][ ][0-9][0-9]" Then
                blnIsItValid = True
                ValidPostalCode = blnIsItValid
                Exit Function
            Else
                blnIsItValid = False
                ValidPostalCode = blnIsItValid
                Exit Function
            End If
    End Select
End Function

I used a wiki page to get the postal code formats for many different countries, which has helped, and I can add more checks if needed and our client adds more places to ship to. I also use the following to set formatting (especially for the (&*&(^&%%$% US zip codes that start w/ a zero):

Sub ZipCodeFormat()
    Dim i as integer
    
    Application.ScreenUpdating = False
    Sheets("Paste").Activate
    for i = 2 to 250
        Rows("R" & i & "C19").Select
        Select Case Rows("R" & i & "C19")
            Case "US"
                Selection.Format = "00000"
            Case ""
                Selection.Format = "00000"
            Case "CA"
                Selection.Format = "@"
            Case "SE"
                Selection.Format = "#####"
            Case "DE"
                Selection.Format = "#####"
            Case "FR"
                Selection.Format = "#####"
            Case "RU"
                Selection.Format = "######"
            Case "AT"
                Selection.Format = "####"
            Case "CH"
                Selection.Format = "####"
        End Select
    Next i
    Application.ScreenUpdating = True
End Sub

Dunno if this would be a help to anyone, but it helps us to take a .csv database export and manipulate it into something we can import into UPS Worldship and have it spit out labels.