Finding text from another list

[Groves22]

This may be easy... or not, but I can't figure out what to do.

I'm trying to format a list of addresses. They were given to me in 1 column, however, I had to break them out (using 'Text to Columns') each word to it's own column. So now the address ranges from 3 to 7 columns long, depending how many words were in the address.

(ie. old: [123 Big Walk Way], new: [123][Big][Walk][Way], [] symbolizes a column)

I have a list of street suffixes from USPS's website... What I need to do, is scour all columns, and try to pull out the suffix and place in 1 column.

Another detail, some entries will have Street, while others may have St. I need to have everything abbreviated, which I have in the same table as the suffixes. (ie. columnA: Street, columnB: St.)

I hope that made sense...

What I want to happen: (Address :: Suffix column)
[12][Big][Leaf][Avenue] :: [Ave]
[123][3][Mile][Journey][St] :: [St]

 

[Groves22]

Well, this formula seemed to work (with no VBA):

=IF(NOT(ISERROR(VLOOKUP(K2,'street suffix'!$A$4:$B$1011,2,FALSE))),VLOOKUP(K2,'street suffix'!$A$4:$B$1011,2,FALSE),IF(NOT(ISERROR(VLOOKUP(L2,'street suffix'!$A$4:$B$1011,2,FALSE))),VLOOKUP(L2,'street suffix'!$A$4:$B$1011,2,FALSE),IF(NOT(ISERROR(VLOOKUP(M2,'street suffix'!$A$4:$B$1011,2,FALSE))),VLOOKUP(M2,'street suffix'!$A$4:$B$1011,2,FALSE),IF(NOT(ISERROR(VLOOKUP(N2,'street suffix'!$A$4:$B$1011,2,FALSE))),VLOOKUP(N2,'street suffix'!$A$4:$B$1011,2,FALSE),IF(NOT(ISERROR(VLOOKUP(O2,'street suffix'!$A$4:$B$1011,2,FALSE))),VLOOKUP(O2,'street suffix'!$A$4:$B$1011,2,FALSE),"XX")))))

If you have a VBA solution, I would still like to see it, but don't bust your brain trying to help...

Thanks!

 

[SkipVought]

Hi,

You would have been better off with your addresses in ONE COLUMN.

You could have used the Split function to grab the last word in the string. Asuming that your address column is A, starring in row 1...

dim r as range, a
for each r in range([A1], [A1].end(xldown))
   with r
      .offset(0,1).value = split(.value," ")(ubound(split(.value," ")))
   end with
next

the last word will be placed in the adjacent column

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Groves22]

Hey Skip...

Thanks for the idea, however, the suffix isn't always the last word. Sometimes there will be a post direction or apartment number

(ie. 123 Big Walk Road 112A)

 

[SkipVought]

Thats why you should CATEGORIZE the data BEFORE you apply a method.

One method per category!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[ThichTraXanh]

How is your data? I assume as I see

exam: 123 Big Walk Road 112A, seperate by space?

You should import data as 1 column
A1 = 123 Big Walk Road 112A
A2 = .......

dim varObj,varTemp as variant

vartemp = split(range("A" & row).value," ",-1,vbtextcompare)

for each varObj in vartemp
'do what you want
next

Hope it help!

 

[Groves22]

Can you explain exactly how that codes works? I'm an amateur, at best, when it comes to VBA... so some things I just don't get...

I modified the code a bit to make it run for what I want... This is what I have:

Sub test_split()

Dim varObj As Variant, varTemp As Variant, i As Long
i = 2

Do While i <= Range("D1").End(xlDown).Row
    varTemp = Split(Range("D" & i).Value, " ", -1, vbTextCompare)
    
    For Each varObj In varTemp
       Range("E" & i) = varTemp
    Next
    i = i + 1
Loop

End Sub

When I step through ('F8') the code, it will repeatedly go back and forth from these 2 lines:

Range("E" & i) = varTemp
    Next

What is that doing, really? varTemp is outputting the first word/number of the address... Is there a way to have it look at each spaced word/number in the cell?

Thanks

 

[SkipVought]

Something like this would be much more versatile.

First categorize your addresses: Ones with the value you're looking for in the LAST word, ones with NEXT TO LAST, etc.

In an adjacent column enter 0 if LAST and 1 if next to last 2 if next to next to last etc.

Then paste this FUNCTION into a MODULE and use as you would any function on a sheet...

function GetLastWord(Address as string, optional EndOffset as integer=0) as string
   dim a 
   a = split(Address, " ")
   GetLastWord = a(ubound(a)-EndOffset)
end function

You supply the reference for the address and the from end offset.


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[ThichTraXanh]

Your Code:

Sub test_split()

Dim varObj As Variant, varTemp As Variant, i As Long
i = 2

Do While i <= Range("D1").End(xlDown).Row
varTemp = Split(Range("D" & i).Value, " ", -1, vbTextCompare)

For Each varObj In varTemp
Range("E" & i) = varTemp <-- varObj
Next
i = i + 1
Loop

End Sub

Purpose of my code is to split the string into Array (varTemp), after that you can do whatever you want.

Exam: I modify your code, assume you want to put them in order: from cell A split to B,C,D,E,F

Sub test_split()

Dim varObj As Variant, varTemp As Variant,
dim i,j As Long
i = 2 'Row
j= 2 'Col

Do While i <= Range("D1").End(xlDown).Row
varTemp = Split(Range("D" & i).Value, " ", -1, vbTextCompare)

for each varObj in varTemp
cell(i,j) = varObj 'Cell B
j = j+1
next

i = i + 1
Loop

End Sub

 

[Groves22]

Skip...

I never knew you could make your own functions. Wow... my mind = blown! I will put that to good use!

Your way is helping me out a lot!

I would also like to thank you for a lot of the help you have given me in the past year or so... I'm glad there is a site like this I can come to!

Thanks,
Josh

 

[SkipVought]

Thanks! Glad to share.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Groves22]

Why is this not working?

Function GetDir(Direct As String)

    Dim DirAbbr As String
    DirAbbr = Direct
    
    Select Case DirAbbr
        Case "E" Or "West"
            GetDir = "W"
        Case "E" Or "East"
            GetDir = "E"
        Case "S" Or "South"
            GetDir = "S"
        Case "N" Or "North"
            GetDir = "N"
        Case Else
            GetDir = ""
    End Select
End Function

The formula I am using is: =getdir(O2); where O2 = "West

 

[Groves22]

I did just notice a typo, but that shouldn't bomb the function

Function GetDir(Direct As String)

    Dim DirAbbr As String
    DirAbbr = Direct
    
    Select Case DirAbbr
        Case [RED]"W"[/RED] Or "West"
            GetDir = "W"
        Case "E" Or "East"
            GetDir = "E"
        Case "S" Or "South"
            GetDir = "S"
        Case "N" Or "North"
            GetDir = "N"
        Case Else
            GetDir = ""
    End Select
End Function

 

[SkipVought]

Function GetDir(Direct As String)
    Select Case Direct 
        Case "W", "West","E", "East","S", "South","N", "North"
            GetDir = left(Direct,1)
        Case Else
            GetDir = ""
    End Select
End Function

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Groves22]

Thanks, Skip!

 

[Groves22]

OK... So I almost have everything done with this!

Here's an quick overview of what's going on now;

I was given a list of addresses that appeared like this: [123 West Boring St. Apt12], all in one column. I needed to format into several columns which include; [Street Number][Street Pre-Direction][Street Name][Street Type][Street Pos-Direction][Street Address line 2]

I have everything into their desired columns, except I am having trouble getting the [Street Name] out correctly. All the other columns, I was able to build functions to gather, with your guys' help.

Option Explicit

Function GetLastWord(Address As String, Optional EndOffset As Integer = 0) As String
   Dim a
   a = Split(Address, " ")
   GetLastWord = a(UBound(a) - EndOffset)
End Function

Function GetFirstWord(Address As String, Optional EndOffset As Integer = 0) As String
   Dim a
   a = Split(Address, " ")
   GetFirstWord = a(LBound(a) + EndOffset)
End Function

Function GetDir(Direct As String)
    Select Case Direct
        Case "W", "WEST", "E", "EAST", "S", "SOUTH", "N", "NORTH"
            GetDir = Left(Direct, 1)
        Case Else
            GetDir = ""
    End Select
End Function

Some tweaks and formulas here and there has all the outliers pulled... but I can't get to the street. I tried a complex MID formula containing FIND, but there are too many scenarios to the formula to work correctly. And the fact that each address has varying words for the street it making this more stressful than it should be!

Anyone have hints/tips to get the street name out from the address...

Thanks

 

[SkipVought]

... but there are too many scenarios to the formula to work correctly

Analyze & categorize.

THEN apply a specific method to each category.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Groves22]

Just to update... this may or not be the best way, but it seems to work:

Sub get_address_1()

Dim AllParts As Variant, thing As Variant
Dim i As Long, j As Long, a As Long, LastR As Long

i = 2
j = 26
a = 35
LastR = Range("D1").End(xlDown).Row

Do While i <= LastR
    AllParts = Split(Range("D" & i).Value, " ", -1, vbTextCompare)
        For Each thing In AllParts
            If thing = Range("E" & i) Or thing = Range("L" & i) Or thing = Range("M" & i) Or thing = Range("N" & i) Or thing = Range("T" & i) Or thing = Range("Y" & i) Then
                Cells(i, a) = Empty
            Else
                Cells(i, a) = thing
            End If
            a = a + 1
        Next
    i = i + 1
    j = 26
    a = 35
Loop

End Sub

This code is looking at the string, word by word. If it's present in one of the other parts, skip it. If it's not, print... I then CONCATENATEd the unused texts into the street name...

Thanks everyone for their suggestions and help!

 

[Groves22]

Just when I thought I was in the clear...

OK... The data I was given needed broken into 2 different groups. I copied the tab I used to pull the addresses apart, and placed in the other set of data.

The GetFirstWord & GetDir functions are working, but the GetLastWord function is returning blanks/errors. The two tabs are identical so why is it not working on this tab, when the other 2 are?

Code:

[RED]Function GetLastWord(Address As String, Optional EndOffset As Integer = 0) As String
   Dim a
   a = Split(Address, " ")
   GetLastWord = a(UBound(a) - EndOffset)
End Function[/RED]

Function GetFirstWord(Address As String, Optional EndOffset As Integer = 0) As String
   Dim a
   a = Split(Address, " ")
   GetFirstWord = a(LBound(a) + EndOffset)
End Function

Function GetDir(Direct As String)
    Select Case Direct
        Case "W", "WEST", "E", "EAST", "S", "SOUTH", "N", "NORTH"
            GetDir = Left(Direct, 1)
        Case Else
            GetDir = ""
    End Select
End Function

 

[SkipVought]

Both First & Last seem to work just fine.

How are you using the Last function? COPY the formula that is not working, from the formula bar.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]