Extract Street Name from Address

[JarekM]

My sheet has a list of addresses, split into 2 columns.

I would like to extract the street name only, excluding everything else. The tricky part is that some addresses list the direction before the street name & type, and some list it after.

Example:

2355 N Long Valley St
123 Georgia Ave NW

I would like to return only "Long Valley" and "Georgia"

Thanks in advance.

 

[Zot]

I think you should provide a good number of samples so that helpers can give an ultimate workable solution. Otherwise, end up keep modifying solution. ?

 

[JarekM]

Here is an example, I only want the street name extracted from column A, nothing else, such as the direction, state, city name, etc...

I am looking for someone that can help write a VBA code or formula, but I would prefer VBA.

 

[Zot]

With 3 samples provided

Book1.xlsm
	A	B
1
2	Address	Street
3	1245 N Long Vallet St, Rochester NY 60567
4	6734 SW Dearlove ct, Parkview, IL 60243
5	7454 Belden st, Park Ridge, NM 60634
Sheet1

Try this. Maybe others have simpler code

Sub GetStreet()

Dim strTest As String
Dim cell As Range, rngAdd As Range
Dim ws As Worksheet
Dim RegEx As Object, matches As Object

Set RegEx = CreateObject("VBScript.RegExp")
Set ws = ActiveWorkbook.Sheets("Sheet1")       ' Rename accordingly if required
Set rngAdd = ws.Range("A3", ws.Cells(Rows.Count, "A").End(xlUp))

Application.ScreenUpdating = False

For Each cell In rngAdd
    strTest = Split(cell.Value, ",")(0)
    With RegEx
        .Pattern = "\d{1,4}\s(NE|SE|SW|NW|N|S|E|W)?\s?"
        .Global = True
        .IgnoreCase = True
        Set matches = .Execute(strTest)
        strTest = Replace(strTest, matches(0), "")
        .Pattern = "\s(st|ct)"
        Set matches = .Execute(strTest)
        strTest = Replace(strTest, matches(0), "")
    End With
    cell.Offset(0, 1) = strTest
Next

End Sub

 

[bebo021999]

Is there anything else out of st,ct to indicate street? At least, I know boulevard, blv ... and also ","
Give more samples.

 

[JarekM]

With 3 samples provided

Book1.xlsm
	A	B
1
2	Address	Street
3	1245 N Long Vallet St, Rochester NY 60567
4	6734 SW Dearlove ct, Parkview, IL 60243
5	7454 Belden st, Park Ridge, NM 60634
Sheet1

Try this. Maybe others have simpler code

Sub GetStreet()

Dim strTest As String
Dim cell As Range, rngAdd As Range
Dim ws As Worksheet
Dim RegEx As Object, matches As Object

Set RegEx = CreateObject("VBScript.RegExp")
Set ws = ActiveWorkbook.Sheets("Sheet1")       ' Rename accordingly if required
Set rngAdd = ws.Range("A3", ws.Cells(Rows.Count, "A").End(xlUp))

Application.ScreenUpdating = False

For Each cell In rngAdd
    strTest = Split(cell.Value, ",")(0)
    With RegEx
        .Pattern = "\d{1,4}\s(NE|SE|SW|NW|N|S|E|W)?\s?"
        .Global = True
        .IgnoreCase = True
        Set matches = .Execute(strTest)
        strTest = Replace(strTest, matches(0), "")
        .Pattern = "\s(st|ct)"
        Set matches = .Execute(strTest)
        strTest = Replace(strTest, matches(0), "")
    End With
    cell.Offset(0, 1) = strTest
Next

End Sub

Hi, sorry for the late response, I didn't have access to my computer for a few days.

As for your code, it gives me an error when I run it. The error can be seen in the image:

When I go to debug the error, it tells me that I have that error on this line:

 strTest = Replace(strTest, matches(0), "")

When I block that line of code, I am able to run it and this is what shows up:

It works somewhat. The st, ct, ave, etc... still shows up in the street name. Also the W in Williamsburg didn't show up in the street name. I think I figured that one out by putting a space after the directions in this line of code:

.Pattern = "\d{1,9}\s(NE |SE |SW |NW |N |S |E |W )?\s?"

. I just wanted to ask if this fix will work indefinitely?

 

[JEC]

Try this

Sub jec()
 Dim ar, sp As Variant, sq As Long, i As Long, x As Long
 ar = Cells(1, 1).CurrentRegion
 
 For i = 2 To UBound(ar)
    sp = Split(Split(ar(i, 1), ",")(0), " ", 2)
    If UBound(Split(sp(1))) > 1 Then x = 1 Else x = 0
    sp = Split(sp(1), " ", 2)(x)
    sq = InStrRev(sp, " ", -1)
    ar(i, 2) = Left(sp, IIf(sq = 0, Len(sp), sq - 1))
 Next
   
 Cells(1, 1).CurrentRegion = ar
End Sub

 

[JarekM]

Try this

Sub jec()
 Dim ar, sp As Variant, sq As Long, i As Long, x As Long
 ar = Cells(1, 1).CurrentRegion
 
 For i = 2 To UBound(ar)
    sp = Split(Split(ar(i, 1), ",")(0), " ", 2)
    If UBound(Split(sp(1))) > 1 Then x = 1 Else x = 0
    sp = Split(sp(1), " ", 2)(x)
    sq = InStrRev(sp, " ", -1)
    ar(i, 2) = Left(sp, IIf(sq = 0, Len(sp), sq - 1))
 Next
  
 Cells(1, 1).CurrentRegion = ar
End Sub

Thank you, the code works well. Can you also explain your code. I'm not an expert in VBA, but I would like to know what it does so that way I would know how to adjust it in the future.

 

[Zot]

I will try to explain some of the basic.

Based in this sample:
1245 N Long Vallet St, Rochester NY 60567

Assume a=1245 N Long Vallet St, Rochester NY 60567
Split(a,",") 'Split the expression a with "," as Delimiter gives two objects (not really an array I think)
"1245 N Long Vallet St"
" Rochester NY 60567"

The index starts with 0. So, the first one has index 0 which can be referred as
Split(a,",")(0) ---- which is "1245 N Long Vallet St"

Then Split(a,",")(0) is split again, like
Split(Split(a,",")(0)) ----- Note that if no Delimiter is specified, the default is space " ".
The results are
1245
N
Long
Vallet
St

I was using RegExp script approach in combination with split. Not sure what was wrong but for your 3 sample, the results are just fine on my PC; but you have other working solution already.