Format Canadian Postal Code on Entry

**Gos-C** · 02-05-2007, 08:11 PM

Hi everyone,

I can't find a custom format to validate a properly formatted Canadian postal code on entry, so I think my last hope is to ask someone to write me a VBA code.

Canadian postal codes consist of six characters with a space in the middle: a capital letter, a number, a capital letter, a space, a number, a capital letter, and a number. Therefore, M2A 3J4 is a properly formated postal code.

I want a code to fix an improperly fomatted postal code (such as M2A3J4 or m2a3j4 or m3a 2j4) on entry.

Can anyone please help me?

Thanks,
Gos-C

**mudraker** · 02-05-2007, 10:20 PM

Gos-C

Try this macro - It does not verify Letters & Number are placed in the correct order - This can be added if required.

Copy this macro
Goto Excel
Right Click on Sheet Name Tab > select View Code
Past macro into the Worksheet Module displayed

Change Column number to suit (shown In red in this posting)
Return to Excel and test

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range
   
   For Each Rng In Target
      If Rng.Column = 1 Then
         Application.EnableEvents = False
         Select Case Len(Rng.Value)
         Case 6
            Rng.Value = UCase(Left(Rng.Value, 3) & " " & Right(Rng.Value, 3))
         Case 7
            Rng.Value = UCase(Rng.Value)
         End Select
      End If
   Next Rng
   Application.EnableEvents = True
End Sub

**Gos-C** · 02-06-2007, 08:10 AM

Hi Mudraker,

Thank you very much. It works but, if you don't mind, can you add the verification of the letters and numbers in the correct order. That would be perfect. I really appreciate your help.

Thanks again,
Gos-C

**mudraker** · 02-06-2007, 04:30 PM

Gos

This version verifies letters, numbers, space in correct location.

Change Column number to suit

For invalid Postcode entries if you remove the ' before 'rng.ClearContents it will clear the entry

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range
   Dim iChar As Integer
   
   For Each Rng In Target
      If Rng.Column = 1 Then
         Application.EnableEvents = False
         Select Case Len(Rng.Value)
         Case 6
            Rng.Value = UCase(Left(Rng.Value, 3) & " " & Right(Rng.Value, 3))
         Case 7
            Rng.Value = UCase(Rng.Value)
         End Select
         If Len(Rng.Value) <> 7 Then
            MsgBox "Invalid Post Code Entyry in " & Rng.Address
            Exit For
         End If
         For iChar = 1 To 7 Step 1
            Select Case Mid(Rng.Value, iChar, 1)
            Case "A" To "Z"
               Select Case iChar
               Case 2, 4, 5, 7
                  MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                  & " is invalid for Postcode"
                  'rng.ClearContents
                  Exit For
               End Select
            Case 0 To 9
               Select Case Mid(Rng.Value, iChar, 1)
               Case 1, 3, 4, 6
                  MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                  & " is invalid for Postcode"
                  'rng.ClearContents
                  Exit For
               MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                  & " is invalid for Postcode"
                  'rng.ClearContents
                  Exit For
               End Select
            Case " "
               Select Case Mid(Rng.Value, iChar, 1)
               Case 1 To 3, 5 To 7
                  MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                     & " is invalid for Postcode"
                  'rng.ClearContents
                  Exit For
               End Select
            Case Else
               MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                     & " is invalid for Postcode"
                  'rng.ClearContents
               Exit For
            End Select
         Next iChar
      End If
   Next Rng
   Application.EnableEvents = True
End Sub

**oldchippy** · 02-06-2007, 05:05 PM

Here's an alternative if you require a formula, with your data entry in A1, then this in B1

=LEFT(UPPER(A1),3)&" "&RIGHT(UPPER(A1),3)

**Gos-C** · 02-07-2007, 09:34 AM

Hi Mudraker,

Thanks again for taking time to help me. I sincerely appreciate it.

When I enter an improperly formatted postal code -- e.g., a1b2c3 -- in cell A1, it gets formatted properly (A1B 2C3) but I get the message: $A$1 - 1 is invalid for Postcode. It happens all the time. Do I need to modify the code?

Thanks,
Gos-C

**mudraker** · 02-07-2007, 03:53 PM

I should have been a bit more thourgh on the testing before posting the code

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range
   Dim iChar As Integer
   
   For Each Rng In Target
      If Rng.Column = 1 Then
         Application.EnableEvents = False
         Select Case Len(Rng.Value)
         Case 6
            Rng.Value = UCase(Left(Rng.Value, 3) & " " & Right(Rng.Value, 3))
         Case 7
            Rng.Value = UCase(Rng.Value)
         End Select
         If Len(Rng.Value) <> 7 Then
            MsgBox "Invalid Post Code Entyry in " & Rng.Address
            Exit For
         End If
         For iChar = 1 To 7 Step 1
            Select Case Mid(Rng.Value, iChar, 1)
            Case "A" To "Z"
               Select Case iChar
               Case 2, 4, 5, 7
                  MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                  & " is invalid for Postcode"
                  'rng.ClearContents
                  Exit For
               End Select
            Case 0 To 9
               Select Case iChar
               Case 1, 3, 4, 6
                  MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                  & " is invalid for Postcode"
                  'rng.ClearContents
                  Exit For
               End Select
            Case " "
               Select Case iChar
               Case 1 To 3, 5 To 7
                  MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                     & " is invalid for Postcode"
                  'rng.ClearContents
                  Exit For
               End Select
            Case Else
               MsgBox Rng.Address & " - " & Mid(Rng.Value, iChar, 1) _
                     & " is invalid for Postcode"
                  'rng.ClearContents
               Exit For
            End Select
         Next iChar
      End If
   Next Rng
   Application.EnableEvents = True
End Sub

**Gos-C** · 02-07-2007, 08:45 PM

Got it! Mudraker, you're the best! Thanks a million.

Gos-C

**mudraker** · 02-07-2007, 10:24 PM

Glad to hear all is now working correctly & thanks for the feed back

**gajendra.gupta** · 02-08-2007, 01:06 AM

I beleive this might also helpful if you are entering Postcode in Range 'A1'.

Sub Postal_Verify()
If Len(Range("A1").Text) = 6 And _
IsAlpha(Mid(Range("A1").Text, 1, 1)) = True And _
IsAlpha(Mid(Range("A1").Text, 3, 1)) = True And _
IsAlpha(Mid(Range("A1").Text, 5, 1)) = True And _
IsNumeric(Mid(Range("A1").Text, 2, 1)) = True And _
IsNumeric(Mid(Range("A1").Text, 4, 1)) = True And _
IsNumeric(Mid(Range("A1").Text, 6, 1)) = True Then
Range("A1") = Left(Range("A1"), 3) & " " & Right(Range("A1"), 3)
Else
MsgBox "Invalid Postal Code."
End If
End Sub
Function IsAlpha(chr As String) As Boolean
If Asc(chr) >= 97 And Asc(chr) <= 122 Or Asc(chr) >= 65 And Asc(chr) <= 90 Then
IsAlpha = True
Else
IsAlpha = False
End If
End Function

Regards,
Gajendra Gupta

**gajendra.gupta** · 02-08-2007, 01:41 AM

This is even more simpler..

Sub Postal_Verify()
If Range("D1") Like "[A-Za-z][0-9][A-Za-z][0-9][A-Za-z][0-9]" Then
Range("A1") = Left(Range("A1"), 3) & " " & Right(Range("A1"), 3)
Else
MsgBox "Invalid Postal Code."
End If
End Sub

Regards,
Gajendra Gupta

**mudraker** · 02-08-2007, 02:03 AM

Gajendra

Fantastic bit of code - I would never have thought of using Like

I have modified my macro to incorporate your code.

The new macro retains all the requirements as per Gos-C 1st posting and is much simpler than what I had coded

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range
   Dim iChar As Integer
   
   For Each Rng In Target
      If Rng.Column = 1 Then
         Application.EnableEvents = False
         Select Case Len(Rng.Value)
         Case 6
            Rng.Value = UCase(Left(Rng.Value, 3) & " " & Right(Rng.Value, 3))
         Case 7
            Rng.Value = UCase(Rng.Value)
         End Select
         If Rng.Value Like "[A-Z][0-9][A-Z][ ][0-9][A-Z][0-9]" Then
            'do nothing
         Else
            MsgBox Rng.Address & " - invalid Postcode"
         End If
      End If
   Next Rng
   Application.EnableEvents = True
End Sub

**Gos-C** · 02-09-2007, 11:11 AM

Hi Mudraker,

This is certainly going to be a popular/much sought-after code. Good job! I think it would be better if the invalid postal code is cleared when the message is shown. Do you mind adding this last bit?

Gajendra, thanks also for your great input.

Regards,
Gos-C

**mudraker** · 02-09-2007, 04:18 PM

Gos-C

Contents now cleared on invalid postcodes - New line shown in red

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Rng As Range
   Dim iChar As Integer
   
   For Each Rng In Target
      If Rng.Column = 1 Then
         Application.EnableEvents = False
         Select Case Len(Rng.Value)
         Case 6
            Rng.Value = UCase(Left(Rng.Value, 3) & " " & Right(Rng.Value, 3))
         Case 7
            Rng.Value = UCase(Rng.Value)
         End Select
         If Rng.Value Like "[A-Z][0-9][A-Z][ ][0-9][A-Z][0-9]" Then
            'do nothing
         Else
            MsgBox Rng.Address & " - invalid Postcode"
            Rng.ClearContents
         End If
      End If
   Next Rng
   Application.EnableEvents = True
End Sub