Question

I’m trying to write a VBA function in Access that replaces words in an address field with the standard United States Postal Abbreviations. I realize this is never going to be perfect, but I want to at least make simple abbreviations (without having to purchase address formatting software), e.g.

 input      output
 -------    -------------
 North   -> N
 Street  -> ST
 Drive   -> DR
 Lane    -> LN

I thought about using a simple table to store the string and the replacement string, and then looping through that table/recordset to perform a simple search and replace using the Replace() function, e.g. using the immediate window:

 ?Replace("123 North 3rd St", "North", "N", compare:=vbTextCompare)
 123 N 3rd St

However, this method can potentially cause errors, e.g.

 ?Replace("123 Northampton St", "North", "N", compare:=vbTextCompare)
 123 Nampton St

My original strategy was to create a replacement table with regular expression patterns and replacement strings, then loop through that table to do a more precise search and replace.

pattern                 abbrev
-------------------     ------------
{pattern for North}     N
{pattern for Street}    ST

I realized that RegEx might be overkill here, especially since I’m going to be looping through address fields over and over in a database, but couldn’t think of an easier way just using the Replace() function (Update: see responses from @mwolfe02 and @Cylian, and a hybrid solution).

In the above example, I want to search for the words North and Street when they are either as a exist as word in a string (thus separated by two white spaces) or at the end of the string or beginning of a string. This covers most of the situations that warrant an abbreviation. e.g.

address                       formatted
----------------------        --------------------------
123 North 3rd St           -> 123 N 3RD ST
123 ABC Street North       -> 123 ABC ST N
North 3rd Street           -> N 3RD ST
123 North Northampton St   -> 123 N NORTHAMPTON ST

As in these examples, I want to replace all instances of the pattern in the string. I also am converting everything to upper case (I can use UCase() on the final result no problem).

Does anyone know of an existing module that does this sort of thing? Can anyone help with the pattern matching as in the above examples? For extra credit, I’m curious also about creating rule in the table to format post office boxes, e.g.

address                   formatted
----------------------    --------------------------
P.O. Box 345           -> PO BOX 345
PO Box 345             -> PO BOX 345
Post Office Box 345    -> PO BOX 345
PO. Box 345            -> PO BOX 345
P. O. Box 345          -> PO BOX 345

This stack overflow post gives the following pattern to recognize some PO boxes “^\s*P.?\s?O.?\sB[Oo][Xx].” (admittedly not the third example above). Again, I’m not as comfortable with matching and replacement sets to figure out how to write this more precise replace function. Is there a RegEx/Access expert who can help?

Answer 1

I created a very simple reference table ref_USPS_abbrev from the USPS Abbreviation list online. Here’s the entries that correspond to the example originally given:

WORD          ABBREV
------------  -------------
NORTH         N
STREET        ST

Then, incorporating responses to my original post, I created two helper functions.

From @Cylian:

    ' ----------------------------------------------------------------------'
    '  Formats string containing P.O. Box to USPS Approved PO BOX format    '
    ' ----------------------------------------------------------------------'
    '  Requires Microsoft VBScript Regular Expressions 5.5

    Public Function FormatPO(inputString As String) As String

        Static rePO As Object
        If rePO Is Nothing Then
            Set rePO = CreateObject("vbscript.regexp")
        With rePO
        .Pattern = "\bP(?:[. ]+|ost +)?O(?:ff\.?(?:ice))" & _
                   "?[. ]+B(?:ox|\.) +(\d+)\b"
        .Global = True
        .IgnoreCase = True
        End With
        End If

        With rePO
           If .Test(inputString) Then
              FormatPO = .Replace(inputString, "PO BOX $1")
           Else
              FormatPO = inputString
           End If
        End With
    End Function

And, using @mwolfe02’s excellent idea:

    ' ----------------------------------------------------------------------'
    '  Replaces whole word only with an abbreviation in address string      '
    ' ----------------------------------------------------------------------'

    Public Function AddressReplace(AddressLine As String, _
                    FullName As String, _
                    Abbrev As String)

    'Enclose address line in an opening and closing space, so that you 
    'can require an opening and closing space on each word you are trying 
    'to replace. Finish up with a trim to get rid of those temporary spaces.

    AddressReplace = Trim(Replace(" " & AddressLine & " ", _
                              " " & FullName & " ", _
                              " " & Abbrev & " "))
    End Function

Then, incorporating these helper functions, I wrote this function:

' ----------------------------------------------------------------------'
'  Format address using abbreviations stored in table ref_USPS_abbrev   '
' ----------------------------------------------------------------------'  
'  Requires Microsoft DAO 3.6 Object Library
'  Table ref_USPS_abbrev has two fields: WORD (containing the word to match) 
'  and ABBREV containing the desired abbreviated substitution.
'  United States Postal Services abbreviations are available at:
'  https://www.usps.com/ship/official-abbreviations.htm

Public Function SubstituteUSPS(address As String) As String

Static dba As DAO.Database
Static rst_abbrev As DAO.Recordset

    If IsNull(address) Then Exit Function

    'Initialize the objects 

    If dba Is Nothing Then
        Set dba = CurrentDb
    End If

    'Create the rst_abbrev recordset once from ref_USPS_abbrev. If additional
    'entries are added to the source ref_USPS_abbrev table after the recordset 
    'is created, since it is an dbOpenTable (by default), the recordset will 
    'be updated dynamically. If you use dbOpenSnapshot it will not update 
    'dynamically.

    If rst_abbrev Is Nothing Then
        Set rst_abbrev = dba.OpenRecordset("ref_USPS_abbrev",  _
                                           Type:=dbOpenTable)
    End If

    'Since rst_abbrev is a static object, in the event the function is called 
    'in succession (e.g. while looping through a recordset to update values), 
    'move to the first entry in the recordset each time the function is 
    'called.

    rst_abbrev.MoveFirst

    'Only call the FormatPO helper function if the address has the 
    'string "ox" in it.    

    If InStr(address, "ox") > 0 Then
        address = FormatPO(address)
    End If

    'Loop through the recordset containing the abbreviations
    'and use the AddressReplace helper function to substitute 
    'abbreviations for whole words only.

    Do Until rst_abbrev.EOF
        address = AddressReplace(address, rst_abbrev![WORD],  _
                                 rst_abbrev![ABBREV])
        rst_abbrev.MoveNext
    Loop

    'Convert the address to upper case and trim white spaces and return result
    'You can also add code here to trim out punctuation in the address, too.

    SubstituteUSPS = Trim(UCase(address))

End Function

To create the ref_USPS_abbrev table for testing:

Sub CreateUSPSTable()

Dim dbs As Database
Set dbs = CurrentDb

With dbs
    .Execute "CREATE TABLE ref_USPS_abbrev " _
        & "(WORD CHAR, ABBREV CHAR);"
    .Execute " INSERT INTO ref_USPS_abbrev " _
        & "(WORD, ABBREV) VALUES " _
        & "('NORTH', 'N');"
    .Execute " INSERT INTO ref_USPS_abbrev " _
        & "(WORD, ABBREV) VALUES " _
        & "('STREET', 'ST');"
    .Close
End With
End Sub

Finally, testing this function from the immediate window:

 CreateUSPSTable
 ?SubstituteUSPS("Post Office Box 345 123 North Northampton Street")
 PO BOX 345 123 N NORTHAMPTON ST

I’m not a programmer professionally, so I’d welcome suggestions for cleaning up my code even further, but for now this works great. Thanks, everyone.

Stack Overflow yet again FTW!