UK Postcode extractor
Function GetPostCode(Optional AddressText As Variant) As String Dim AddrTextLength As Integer, TempText As String, TempPicture As String Dim PostCodePics(10) As String, PictureItemNum As Integer Dim n As Integer, x As Integer GetPostCode = "" ' default response if no postcode detected If IsNull(AddressText) Then Exit Function End If PostCodePics(1) = "XXNSNXX" ' alternative formats of postcodes PostCodePics(2) = "XXNNSNXX" ' where X = alpha, S = space PostCodePics(3) = "XNNSNXX" ' and N = numeric PostCodePics(4) = "XNSNXX" PostCodePics(5) = "XXNNXX" PostCodePics(6) = "XXNNNXX" PostCodePics(7) = "XNNNXX" PostCodePics(8) = "XNNXX" PostCodePics(9) = "XXNXNXX" PostCodePics(10) = "XXNXSNXX" AddrTextLength = Len(AddressText) If AddrTextLength < 5 Then Exit Function End If If AddrTextLength <= 9 Then TempText = Trim(AddressText) Else TempText = Trim(Right(AddressText, 9)) End If PictureItemNum = 0 TempPicture = "" ' build a picture of the format of current text For n = 1 To Len(TempText) ' detect the type of each character x = InStr(1, "1234567890 ", Mid(TempText, n, 1)) If x > 0 And x < 11 Then TempPicture = TempPicture & "N" If x = 11 Then TempPicture = TempPicture & "S" If x = 0 Then TempPicture = TempPicture & "X" Next For n = 1 To 10 ' compare the format of the current text x = Len(PostCodePics(n)) ' against each of the post code pictures If Len(TempPicture) >= x Then If Right(TempPicture, x) = PostCodePics(n) Then PictureItemNum = n GetPostCode = UCase(Right(TempText, x)) Exit For End If End If Next If PictureItemNum > 4 And PictureItemNum < 10 Then ' insert space in the middle if not present GetPostCode = Left(GetPostCode, Len(GetPostCode) - 3) & " " & Right(GetPostCode, 3) End If End Function