How do I separate name and address when all are the same cell?

[jennilawrence13]

Example 1 (first name has initial and he lists his wife)
ABBOTT, J. SCOTT & BARBRA ANN 101 SUGARBEAR RD EATONTON, GA 31024 444-266-3244 266-7454
Example 2 (name of apt complex included and the unit) (city is 2 words)
ADAMS, WANDA PINNACLE POINT 905 GREENPOND RD UNIT F-300 NORTH MACON, GA 31024
Example 3 (business name included on end) (zip +4 is included)
AGGIE, NEAL 666666 WESTYAWN CIRCLE APT 35476 MACON, GA 31210-9999 MANCHESTER NURSERY
Example 4 (business name and tax id included)
<TABLE style="WIDTH: 267pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=356><COLGROUP><COL style="WIDTH: 267pt; mso-width-source: userset; mso-width-alt: 13019" width=356><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: #ffffff; BORDER-LEFT: #ffffff; BACKGROUND-COLOR: transparent; WIDTH: 267pt; HEIGHT: 12.75pt; BORDER-TOP: #ffffff; BORDER-RIGHT: #ffffff" class=xl65 height=17 width=356>ALPHA-OMEGA FRATERNITY 3191 SOPERTON HGWY EASTMAN GA 31023 TAX ID 300300100
Example 5 (2 word city) (2 phone numbers included at end)
ANDERSON, JENNI 4614 N. MAPLEWOOD DRIVE WARNER ROBINS, GA 34444 478-477-3899 960-7454
</TD></TR></TBODY></TABLE>Be reminded that all of this data is in ONE cell. Can anyone please help? I've MID and TRIM and SEPARATE'd until I'm blue in the face...

 

[jennilawrence13]

.xlsx

 

[xladept]

Hello JenniLawrence13,

Here's some code that works on your sample:

Sub Deconcatenation(): Dim S, L, F, A, Z, R As String, i, j, k, h As Integer
S = Trim(ActiveCell)
If S = "" Then Exit Sub
i = InStr(1, S, ",")
If i Then
L = Mid(S, 1, i - 1): S = Trim(Mid(S, i + 1, Len(S)))
For j = 1 To Len(S)
If IsNumeric(Mid(S, j, 1)) Then
F = Trim(Mid(S, 1, j - 1))
R = Trim(Mid(S, j, Len(S)))
GetTheRest:
i = InStr(1, R, ",")
If i Then
k = InStr(i + 4, R, " ")
A = Trim(Mid(R, 1, k - 1))
Z = Trim(Mid(R, k + 1, Len(R)))
h = InStr(1, Z, " ")
If h = 0 Then R = ""
If h Then
R = Trim(Mid(Z, h + 1, Len(Z)))
Z = Trim(Mid(Z, 1, h - 1))
End If: End If: GoTo Post: End If: Next j
Else:
GoTo NoCom: End If
NoCom:
For j = 1 To Len(S)
If IsNumeric(Mid(S, j, 1)) Then
F = "The"
L = Trim(Mid(S, 1, j - 1))
R = Trim(Mid(S, j, Len(S)))
k = InStr(1, R, " ")
For i = k + 1 To Len(R)
If IsNumeric(Mid(R, i, 1)) Then
j = InStr(i, R, " ")
A = Trim(Mid(R, k + 1, i - (k + 1)))
Z = Trim(Mid(R, i, k))
R = Trim(Mid(R, j, Len(R)))
Exit For: End If: Next i: Exit For: End If: Next j
Post:
ActiveCell.Offset(0, 1) = F
ActiveCell.Offset(0, 2) = L
ActiveCell.Offset(0, 3) = A
ActiveCell.Offset(0, 4) = Z
ActiveCell.Offset(0, 5) = R
ActiveCell.Offset(1, 0).Select
Deconcatenation
End Sub

You need to select the first record and it will run until a null record is encountered.

If there are other record types - you'll have to tweak, as a matter of fact - it looks like tweak city!

 

[jennilawrence13]

No kidding! Tweak city, indeed!! The ones that it does seem to work with still have the city and state on the end of the address string, but HEY, it's a start!

 

[xladept]

Oops!

And I don't mean plural object oriented programming - haste makes waste...

Well, obviously, I just use InStr and Mid for the string functions - but you've got InStrRev and Left and Right also at your disposal.

I cavalierly thought that I had at least broken the address field out of the bushes - and I didn't want to have all the fun.

Here's a revision with some indexing fixes - have fun with the rest - and with the inevitable unexpected to come your way.

Sub Deconcatenation(): Dim S, L, F, A, Z, R As String, i, j, k, h As Integer
S = Trim(ActiveCell)
If S = "" Then Exit Sub
i = InStr(1, S, ",")
If i Then
L = Mid(S, 1, i - 1): S = Trim(Mid(S, i + 1, Len(S)))
For j = 1 To Len(S)
If IsNumeric(Mid(S, j, 1)) Then
F = Trim(Mid(S, 1, j - 1))
R = Trim(Mid(S, j, Len(S)))
GetTheRest:
i = InStr(1, R, ",")
If i Then
k = InStr(i + 4, R, " ")
A = Trim(Mid(R, 1, k - 1))
Z = Trim(Mid(R, k + 1, Len(R)))
h = InStr(1, Z, " ")
If h = 0 Then R = ""
If h Then
R = Trim(Mid(Z, h + 1, Len(Z)))
Z = Trim(Mid(Z, 1, h - 1))
End If: End If: GoTo Post: End If: Next j
Else:
GoTo NoCom: End If
NoCom:
For j = 1 To Len(S)
If IsNumeric(Mid(S, j, 1)) Then
F = "The"
L = Trim(Mid(S, 1, j - 1))
R = Trim(Mid(S, j, Len(S)))
k = InStr(1, R, " ")
For i = k + 1 To Len(R)
If IsNumeric(Mid(R, i, 1)) Then
j = InStr(i, R, " ")
A = Trim(Mid(R, 1, i - 1))
Z = Trim(Mid(R, i, k))
R = Trim(Mid(R, j, Len(R)))
Exit For: End If: Next i: Exit For: End If: Next j
Post:
ActiveCell.Offset(0, 1) = F
ActiveCell.Offset(0, 2) = L
ActiveCell.Offset(0, 3) = A
ActiveCell.Offset(0, 4) = Z
ActiveCell.Offset(0, 5) = R
ActiveCell.Offset(1, 0).Select
Deconcatenation
End Sub