Solved: Need Zip code `

I need the zip code parsed into ColumnB from ColumnA

ONTARIO,CA91761<-incorrect format missingspace after state. I can go thru and fix those manually.
ANAHEIM, CA 92801-1195
ORANGE,CA.926672915 <-incorrect format missing dash. I can go thru and fix those manually.
ONTARIO, CA, 91761
LA PALMA CA 90623
PLACENTIA,CA.92870 <- would like the code to replace any periods with a single space
RANCHO CUCAMONGA,CA,91730 <- would like the code add a single space after commas
CHATSWORTH,CA.91311

Sample workbook attached

Thanks

I think this hits all your possible cases

Select the addresses and run the sub, or just use the function

[vba]
Option Explicit
Sub drv()
Dim rCell As Range
Application.ScreenUpdating = False
For Each rCell In Selection.Cells
With rCell.Offset(0, 1)
.NumberFormat = "@"
.Value = GetZipcode(rCell.Value)
End With
Next
Application.ScreenUpdating = True
End Sub

Function GetZipcode(s As String) As String
If Right(s, 6) Like "[!0-9][0-9][0-9][0-9][0-9][0-9]" Then
GetZipcode = Right(s, 5)
ElseIf Right(s, 11) Like "[!0-9][0-9][0-9][0-9][0-9][0-9][-][0-9][0-9][0-9][0-9]" Then
GetZipcode = Right(s, 10)
ElseIf Right(s, 10) Like "[!0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]" Then
GetZipcode = Mid(s, Len(s) - 8, 5) & "-" & Right(s, 4)
Else
GetZipcode = vbNullString
End If
End Function
[/vba]

Paul

I appreciate that a lot Paul, your routine works really well in doing what I requested and in handling all the likely variation's.

Wish I had worded better though my full requirement, in that along with the zip in ColumnB, I also need the zip removed from the ColumnA data

I do apologize, and thanks again...

Just combine into single sub

[VBA]
Sub drv()
Dim rCell As Range
Application.ScreenUpdating = False
For Each rCell In Selection.Cells
With rCell
.Offset(0, 1).NumberFormat = "@"
If Right(.Value, 6) Like "[!0-9][0-9][0-9][0-9][0-9][0-9]" Then
.Offset(0, 1).Value = Right(.Value, 5)
.Value = Left(.Value, Len(.Value) - 5)
ElseIf Right(.Value, 11) Like "[!0-9][0-9][0-9][0-9][0-9][0-9][-][0-9][0-9][0-9][0-9]" Then
.Offset(0, 1).Value = Right(.Value, 10)
.Value = Left(.Value, Len(.Value) - 10)
ElseIf Right(.Value, 10) Like "[!0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]" Then
.Offset(0, 1).Value = Mid(.Value, Len(.Value) - 8, 5) & "-" & Right(.Value, 4)
.Value = Left(.Value, Len(.Value) - 9)
Else
.Offset(0, 1).Value = vbNullString
End If

End With
Next
Application.ScreenUpdating = True
End Sub
[/VBA]

Paul

Awesome :cloud9:

I really appreciate your time in doing that for me Paul

Hi again Paul,

I've noticed that there is an occasional address that has information such as a suite description after the zip

Example:
ANAHEIM, CA 92806 UNIT E & F

Would it be much for you to adjust the code to take that into account?

Result should be:
ANAHEIM, CA UNIT E & F in Column A and the Zip put into Column B (same as the code does now)

Thanks

Hi Frank,

FWIW, here are two formulae to parse the data:
Locales (all upper case):
=UPPER(TRIM(SUBSTITUTE(LEFT(A2,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A2&"0123456 789"))-1),".","")))
Zip Codes (minus suites etc):
=IF(ISERROR(SEARCH(" ",MID(A2,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),LEN(A2)))),MID( A2,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),LEN(A2)),LEFT(MID(A2, MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),LEN(A2)),SEARCH(" ",MID(A2,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A2&"0123456789")),LEN(A2)))))

Thanks Paul

I'll give that a shot tomorrow, as its after midnight here and I'm exhausted.

Have a nice day

Thanks,

I needed to add the Unit back in after stripping the zipcode, but I did that manually as there were not very many. Both the formulas and the vba code combined to reduce my overall labor, for which I'm appreciative. -- Thank you both Paul_Hossler and macropod(Paul) for your help.

Hi Frank,

Assuming the parsed locales are in column C and the parsed zipcodes are in column D, you could use the following formula in column E to parse the suites:
=RIGHT(A2,LEN(A2)-FIND(RIGHT(C2,4),A2)-3)

FWIW, the following modification to the previous formula will tidy up the locales, presenting them all with a space before the State abbreviation:
=UPPER(TRIM(SUBSTITUTE(SUBSTITUTE(LEFT(A2,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9}, A2&"0123456 789"))-1),".",""),",",", ")))
There's still a few without commas, but I'm not sure they're worth worrying about.