Sub TestMindy9805()
Dim CityLength As Long
Dim DataOutputArrayRow As Long, SourceArrayRow As Long
Dim SourceArrayColumn As Long
Dim LastRowColumnA As Long, LastRowColumnJ As Long
Dim City As String, State As String, ZipCode As String
Dim DataOutputArray As Variant, SourceDataArray As Variant
LastRowColumnA = Range("A" & Rows.Count).End(xlUp).Row
LastRowColumnJ = Range("J" & Rows.Count).End(xlUp).Row
SourceDataArray = Range("A2:E" & LastRowColumnA)
DataOutputArrayRow = 0
ReDim DataOutputArray(1 To UBound(SourceDataArray), 1 To 4)
For SourceArrayRow = 1 To UBound(SourceDataArray, 1)
For SourceArrayColumn = 1 To UBound(SourceDataArray, 2)
If IsNumeric(Left$(Trim(SourceDataArray(SourceArrayRow, SourceArrayColumn)), 1)) Then
DataOutputArrayRow = DataOutputArrayRow + 1
DataOutputArray(DataOutputArrayRow, 1) = WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn))
If Len(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, SourceArrayColumn + 1))) - _
Len(WorksheetFunction.Substitute(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 1)), " ", "")) = 1 Then
DataOutputArray(DataOutputArrayRow, 1) = DataOutputArray(DataOutputArrayRow, 1) & " " & _
WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, SourceArrayColumn + 1))
ZipCode = Mid$(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 2)), InStrRev(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 2)), " ") + 1)
State = Mid$(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, SourceArrayColumn + 2)), _
InStrRev(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, SourceArrayColumn + 2)), _
" ") - 2, 2)
CityLength = Len(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 2))) - Len(ZipCode) - Len(State) - 2
City = Left$(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 2)), CityLength)
Else
ZipCode = Mid$(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, SourceArrayColumn + 1)), _
InStrRev(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 1)), " ") + 1)
State = Mid$(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 1)), InStrRev(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 1)), " ") - 2, 2)
CityLength = Len(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 1))) - Len(ZipCode) - Len(State) - 2
City = Left$(WorksheetFunction.Trim(SourceDataArray(SourceArrayRow, _
SourceArrayColumn + 1)), CityLength)
End If
DataOutputArray(DataOutputArrayRow, 2) = City
DataOutputArray(DataOutputArrayRow, 3) = State
DataOutputArray(DataOutputArrayRow, 4) = ZipCode
Exit For
End If
Next
Next
Range("G2:J" & LastRowColumnJ).Delete
Range("G2:J" & LastRowColumnA) = DataOutputArray
End Sub