I wrote this module to help me out processing and extracting GB post codes, which can have a number of combinations:
A1 2BC
A12 3BC
AB1 2CD
AB12 3CD
AB1C 2DE
accPostCodeExtract is probably the most useful function here, as it will extract the post code from the end of a long address string. There are options to work with most source string formats. By default, the result will be padded with spaces to length = 8, e.g. "AB1 2CD"
accPostCodePrefix extracts the post code "town", e.g. "AB" from "AB1 2CD"
accPostCodePrefixWithNumber extracts the full post code prefix, e.g. "AB1" from "AB1 2CD"
'accPostCodes
'v1.03 2013-11-29 13:03
'===========================================================================
' HELP CONTACT
'===========================================================================
' Code is provided without warranty and can be stolen and amended as required.
' Tom Parish
' TJP@tomparish.me.uk
' http://baldywrittencod.blogspot.com/2013/11/vba-modules-access-accpostcodes.html
' DGF Help Contact: see BPMHelpContact module
'=========================================================================
' v1.03 accPostCodeExtract: bugfix where original post code already padded to len=8
' v1.02 accPostCodeExtract: added bPadResult option, bugfix where string is just post code
' v1.01 added accPostCodeExtract
' v1.00 original version
Option Explicit
Option Compare Database
Function accPostCode(ByRef PCode, Optional ByVal FWSrcSys) As String
'v1.00 2013-11-29 11:53
Dim sPCode As String, sFWsys As String
On Error Resume Next
sPCode = PCode
sFWsys = FWSrcSys
On Error GoTo 0
If sFWsys = "LO" Then Exit Function
'extract "GB/" from start of NFE PCode
Dim b As Byte
b = InStr(sPCode, "/")
sPCode = Mid(sPCode, b + 1, Len(sPCode))
If sPCode = "" Or sPCode = "0" Or sPCode = "." Or sPCode = "#" Then Exit Function
accPostCode = sPCode
End Function
Function accPostCodePrefix(ByRef PCode, Optional ByVal FWSrcSys) As String
'v1.00 2013-11-29 11:53
'checks first 1-2 characters for alpha prefix
Dim sPCode As String, sFWsys As String
On Error Resume Next
sPCode = PCode
sFWsys = FWSrcSys
On Error GoTo 0
If sFWsys = "LO" Then Exit Function
Dim s As String
sPCode = accPostCode(sPCode)
If sPCode = "" Then Exit Function
s = Left(sPCode, 1)
If IsNumeric(s) Then Exit Function Else accPostCodePrefix = s
s = Mid(sPCode, 2, 1)
If IsNumeric(s) Then Exit Function Else accPostCodePrefix = accPostCodePrefix & s
End Function
Function accPostCodePrefixWithNumber(ByVal PCode, Optional ByVal FWSrcSys) As String
'v1.00 2013-11-29 11:53
'checks first 2 characters for alpha prefix then checks following 2-3 chars for numeric
Dim sPCode As String, sFWsys As String
On Error Resume Next
sPCode = PCode
sFWsys = FWSrcSys
On Error GoTo 0
If sFWsys = "LO" Then Exit Function
Dim b As Byte, APfx As String, ANPfx As String
APfx = accPostCodePrefix(sPCode)
If APfx = "" Then Exit Function
b = InStr(sPCode, " ")
If b > 0 Then
'just use characters before space
ANPfx = Left(sPCode, b - 1)
Else
'no space, deduce logically
'e.g. for AB123CD need AB12, take APfx plus all except last following numeric character
ANPfx = APfx & Mid(sPCode, Len(APfx) + 1, 3)
'e.g. AB123 or AB12C or AB1C2
If ANPfx = sPCode Then
'e.g. AB12[] so only prefix anyway
ElseIf IsNumeric(Mid(ANPfx, Len(ANPfx), 1)) Then
'e.g. AB123[CD] so AB12 3CD
ANPfx = Left(ANPfx, Len(ANPfx) - 1)
ElseIf IsNumeric(Mid(ANPfx, Len(ANPfx) - 1, 1)) Then
'e.g. AB12C[D] so AB1 2CD
ANPfx = Left(ANPfx, Len(ANPfx) - 2)
ElseIf IsNumeric(Mid(ANPfx, 3, 1)) And Not IsNumeric(Mid(ANPfx, 4, 1)) Then
'e.g. AB1C2[DE] so AB1C 2DE
ANPfx = Left(ANPfx, Len(ANPfx) - 1)
Else
'cannot identify
ANPfx = ""
End If
End If
accPostCodePrefixWithNumber = ANPfx
End Function
Function accPostCodeExtract(ByVal FullAddressString, Optional ByVal bPostCodeNoSpace As Boolean = False _
, Optional ByVal bCommaSeparated As Boolean = False, Optional bPadResult As Boolean = True) As String
'v1.03 2013-11-29 13:03
'extracts the post code from the end of a long address string (after the last-but-one space [or comma])
'e.g. "CITY, County, AB12 3CD" becomes "AB12 3CD"
'NB: with "AB123CD" post code formats, use bPostCodeNoSpace = True
'NB: with "City,County,AB12 3CD" format strings, use bCommaSeparated = True
'NB: to pad result to fixed 8 characters, use bPadResult = True
On Error Resume Next
Dim FullString As String
FullString = FullAddressString
If FullString = "" Then Exit Function
Dim sSearchString As String, sCount As Byte
If bCommaSeparated Then
sSearchString = ","
sCount = 1
Else
sSearchString = " "
If bPostCodeNoSpace Then sCount = 1 Else sCount = 2
While InStr(FullString, " ") > 0
FullString = Replace(FullString, " ", " ")
Wend
End If
Dim findspaces() As Integer, f As Integer, fCount As Byte
fCount = 1
While InStr(f + 1, FullString, sSearchString) > 0
ReDim Preserve findspaces(1 To fCount) As Integer
f = InStr(f + 1, FullString, sSearchString)
findspaces(fCount) = f
fCount = fCount + 1
Wend
accPostCodeExtract = Mid(FullString, findspaces(fCount - sCount) + 1, Len(FullString))
If accPostCodeExtract = "" Then accPostCodeExtract = FullString
If bPostCodeNoSpace Then accPostCodeExtract = Left(accPostCodeExtract, Len(accPostCodeExtract) - 3) & " " & Right(accPostCodeExtract, 3)
If bPadResult Then
While Len(accPostCodeExtract) < 8
accPostCodeExtract = Left(accPostCodeExtract, Len(accPostCodeExtract) - 3) & " " & Right(accPostCodeExtract, 3)
Wend
End If
End Function
