Parse US Street Addresses with Regular Expression in VB6

I have a confession to make: this article was actually implemented in VB6 originally. The meat of it is the same, but here’s the VB6 edition in case it’s of interest to anybody.

Enjoy!

Private Sub Form_Load()
    
    Call ClearControls
    
End Sub

Private Sub ClearControls()
    uxHouseNumber = ""
    uxStreetPrefix = ""
    uxStreetName = ""
    uxStreetType = ""
    uxStreetSuffix = ""
    uxApt = ""
    uxAdditionalInfo = ""
End Sub

'---------------------------------------------------------------------------------------
' Procedure : ConstructRegex
' Purpose   : Returns a regular expression pattern for parsing US street addresses
'---------------------------------------------------------------------------------------
'
Private Function ConstructRegex() As String
    
'    ConstructRegex = "^" & _                           -> begin string
'        "(\d+)" & _                                    -> 1 or more digits
'        "(\s+(?:" & GetStreetPrefixes() & "))?" & _    -> whitespace + valid prefix (optional)
'        "(\s+.*?)" & _                                 -> whitespace + one or characters
'        "(?:" & _                                      -> group (optional) {
'            "(\s+(?:" & GetStreetTypes() & "))" & _    ->   whitespace + valid street type
'            "(\s+(?:" & GetStreetSuffixes() & "))?" & _->   whitespace + valid street suffix (optional)
'            "(\s+.*)?" & _                             ->   whitespace + anything else (optional)
'        ")?" & _                                       -> }
'        "$"                                            -> end string

    ConstructRegex = "^" & _
        "(\d+)" & _
        "(\s+(?:" & GetStreetPrefixes() & "))?" & _
        "(\s+.*?)" & _
        "(?:" & _
            "(\s+(?:" & GetStreetTypes() & "))" & _
            "(\s+(?:" & GetStreetSuffixes() & "))?" & _
            "(\s+.*)?" & _
        ")?" & _
        "$"


End Function

'---------------------------------------------------------------------------------------
' Procedure : GetStreetPrefixes
' Purpose   : Returns a pipe-delimited list of valid street prefixes
'---------------------------------------------------------------------------------------
'
Private Function GetStreetPrefixes() As String
    
    GetStreetPrefixes = "TE|NW|HW|RD|E|MA|EI|NO|AU|SE|GR|OL|W|MM|OM|SW|ME|HA|JO|OV|S|OH|NE|K|N"
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetStreetTypes
' Purpose   : Returns a pipe-delimited list of valid street types
'---------------------------------------------------------------------------------------
'
Private Function GetStreetTypes() As String
    
    GetStreetTypes = "TE|STCT|DR|SPGS|PARK|GRV|CRK|XING|BR|PINE|CTS|TRL|VI|RD|PIKE|MA|LO|TER|UN|CIR|WALK|CO|RUN|FRD|LDG|ML|AVE|NO|PA|SQ|BLVD|VLGS|VLY|GR|LN|HOUSE|VLG|OL|STA|CH|ROW|EXT|JC|BLDG|FLD|CT|HTS|MOTEL|PKWY|COOP|ACRES|ESTS|SCH|HL|CORD|ST|CLB|FLDS|PT|STPL|MDWS|APTS|ME|LOOP|SMT|RDG|UNIV|PLZ|MDW|EXPY|WALL|TR|FLS|HBR|TRFY|BCH|CRST|CI|PKY|OV|RNCH|CV|DIV|WA|S|WAY|I|CTR|VIS|PL|ANX|BL|ST TER|DM|STHY|RR|MNR"
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : GetStreetSuffixes
' Purpose   : Returns a pipe-delimited list of valid street suffixes
'---------------------------------------------------------------------------------------
'
Private Function GetStreetSuffixes() As String
    
    GetStreetSuffixes = "NW|E|SE|W|SW|S|NE|N"
    
End Function

'---------------------------------------------------------------------------------------
' Procedure : uxAddress_Change
' Purpose   : Parses user input and displays components to user
'---------------------------------------------------------------------------------------
'
Private Sub uxAddress_Change()
    
    Dim strInput As String
    Dim re As RegExp
    Dim mc As MatchCollection
    Dim ma As Match
    
    Call ClearControls
    
    strInput = UCase$(uxAddress.Text)
    
    Set re = New RegExp
    re.Pattern = ConstructRegex()
    re.Global = True
    
    If re.Test(strInput) Then
        Set mc = re.Execute(strInput)
        Set ma = mc(0)
        
        uxHouseNumber = Trim$(ma.SubMatches(0))
        uxStreetPrefix = Trim$(ma.SubMatches(1))
        uxStreetName = Trim$(ma.SubMatches(2))
        uxStreetType = Trim$(ma.SubMatches(3))
        uxStreetSuffix = Trim$(ma.SubMatches(4))
        uxApt = Trim$(ma.SubMatches(5))
        
        Set ma = Nothing
        Set mc = Nothing
    Else
        uxStreetName = strInput
    End If
    
    Set re = Nothing
    
End Sub

Author: Adam Prescott

I'm enthusiastic and passionate about creating intuitive, great-looking software. I strive to find the simplest solutions to complex problems, and I embrace agile principles and test-driven development. View all posts by Adam Prescott