Hi, Erika-
This code worked on the data I mocked up. It is not at all fault
tolerant: the code assumes there is always a zip code, always a state,
etc. I can include data validation and exceptions report in this code
if the number of errors you see is too great, but I figured this would
be a starting point.

Copy this code into a code module, and run it- it takes about 25
seconds to process (on my machine). Note you'll need to delete column
I before you send it on. Let me know what you think.


Sub LS_Parse()
'screen flicker off
Application.ScreenUpdating = False

'autocalc off
With Application
.Calculation = xlManual
End With

Dim LastRow As Long
Dim K As Byte
Dim Z As Byte

'format zip code column as text to preserve leading zero
Columns("L:L").Select
Selection.NumberFormat = "@"

'determine last row
Range("a1").Select
LastRow = ActiveCell.SpecialCells(xlLastCell).Row

'start of main loop
Do While ActiveCell.Row <= LastRow
'populate array
ReDim arrdata(1 To 7, 1 To 7) As String
For K = 1 To 4
For Z = 1 To 4
arrdata(K, Z) = ActiveCell.Offset(K - 1, Z - 1).Value
Next Z
Next K

'C S Z
For Z = 1 To 4
arrdata(7, Z) = Right(arrdata(4, Z), 5)
arrdata(6, Z) = Mid(arrdata(4, Z), Len(arrdata(4, Z)) - 7, 2)
arrdata(5, Z) = Mid(arrdata(4, Z), 1, Len(arrdata(4, Z)) - 8)
Next Z

'write to outcells
For Z = 1 To 7
For K = 1 To 7
ActiveCell.Offset(K - 1, 4 + Z).Value = arrdata(Z, K)
Next K
Next Z

ActiveCell.Offset(6, 0).Select

Loop
Application.ScreenUpdating = True

With Application
.Calculation = xlAutomatic
End With

Calculate
MsgBox "Done."
End Sub