Complex Parsing Question

**KillerBug** · 03-16-2013, 09:29 PM

I get spreadsheets with thousands of lines and one particular column that is a real pain in the ***. This column contains 4 dates, 2-4 times, and two cities with state abreviations. Sorting these is a nightmare. I was thinking of maybe writing something in python, but thought I would ask here first before I reinvent the wheel. I placed a couple of examples from this column below:

2013-03-16 08:00:00.0 2013-03-18 10:26:38.0 ABERDEEN MD USA,2013-03-18 13:15:00.0 2013-03-18 13:15:00.0 HAGERSTOWN MD USA

2013-03-21 2013-03-21 12:00:00.0 HANOVER PA USA,2013-03-21 15:00:00.0 2013-03-22 23:59:00.0 SUTHERLAND VA USA

2013-03-18 09:00:00.0 2013-03-18 23:58:00.0 LOCK HAVEN PA USA,2013-03-18 09:01:00.0 2013-03-19 23:58:00.0 GORDONSVILLE VA USA

So, ideally I want to make:
1 column for the first date
1 column for the first time...but it should be blank if the first time comes after the second date
1 column for the second date, blank if it comes before the city name
1 column for the second time, blank if it comes before the city name
1 column for the first city name (might be multiple words)
1 column for the first state abreviation
1 column for the third date
1 column for the third time
1 column for the fourth date
1 column for the fourth time
1 column for the second city name
1 column for the second city abreviation

There are a few more things I would probably implement with a python script...but I figure this would get me close enough. Does Excel or OpenOfficeCalc or some other app have such functions built in, or are there free apps in the wild that will do this for me?

**xladept** · 03-17-2013, 01:33 AM

If you have the cell active then this will parse it:

Sub CParse(): Dim S As String, i As Integer
Dim D1 As Date, T1 As Date, D2 As Date, T2 As Date
Dim C1 As String, S1 As String, D3 As Date, T3 As Date
Dim D4 As Date, T4 As Date, C2 As String, S2 As String
S = ActiveCell
S2 = Right(S, 6): S2 = Left(S2, 2): S = Left(S, Len(S) - 6)
D1 = Left(S, 10): S = Right(S, Len(S) - 11)
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then T1 = Left(S, 8)
Else
D2 = Left(S, 10): End If: S = Right(S, Len(S) - 11)
If D2 = 0 Then
D2 = Left(S, 10): S = Right(S, Len(S) - 11): End If
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then
T2 = Left(S, 8)
S = Right(S, Len(S) - 11): End If: End If
i = InStr(1, S, "USA")
C1 = Left(S, i - 5): S1 = Mid(S, i - 3, 2)
S = Right(S, Len(S) - i - 3)
D3 = Left(S, 10): S = Right(S, Len(S) - 11)
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then T3 = Left(S, 8)
Else
D4 = Left(S, 10): End If: S = Right(S, Len(S) - 11)
If D4 = 0 Then
D4 = Left(S, 10): S = Right(S, Len(S) - 11): End If
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then
T4 = Left(S, 8)
S = Right(S, Len(S) - 11): End If: End If
C2 = S
ActiveCell.Offset(0, 1) = D1: ActiveCell.Offset(0, 2) = T1
ActiveCell.Offset(0, 3) = D2: ActiveCell.Offset(0, 4) = T2
ActiveCell.Offset(0, 5) = C1: ActiveCell.Offset(0, 6) = S1
ActiveCell.Offset(0, 7) = D3: ActiveCell.Offset(0, 8) = T3
ActiveCell.Offset(0, 9) = D4: ActiveCell.Offset(0, 10) = T4
ActiveCell.Offset(0, 11) = C2: ActiveCell.Offset(0, 12) = S2

End Sub

Directions for running the routine(s) just supplied

Copy the code to the clipboard

Press ALT + F11 to open the Visual Basic Editor.

Open a macro-enabled Workbook or save your Workbook As Macro-Enabled

Select “Module” from the Insert menu

Type "Option Explicit" then paste the code under it

With the cursor between Sub and End Sub press F5 (F8 to Single Step)

OR

Press ALT + Q to close the code window.

Press ALT + F8 then double click on the macro name

BTW isn't it LOCKE HAVEN???

**KillerBug** · 03-17-2013, 10:05 PM

Wow...thank you. Now, if it isn't too much bother, how can I do it on lots of cells instead of 1 at a time 2800 times?

Lock Haven, PA:
http://goo.gl/maps/fgvDC

**xladept** · 03-17-2013, 10:32 PM

It depends on where they are. If, for instance, they are contiguous then:

Sub CParse(): Dim S As String, i As Integer
Dim D1 As Date, T1 As Date, D2 As Date, T2 As Date
Dim C1 As String, S1 As String, D3 As Date, T3 As Date
Dim D4 As Date, T4 As Date, C2 As String, S2 As String
If ActiveCell = "" Then Exit Sub
S = ActiveCell
S2 = Right(S, 6): S2 = Left(S2, 2): S = Left(S, Len(S) - 6)
D1 = Left(S, 10): S = Right(S, Len(S) - 11)
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then T1 = Left(S, 8)
Else
D2 = Left(S, 10): End If: S = Right(S, Len(S) - 11)
If D2 = 0 Then
D2 = Left(S, 10): S = Right(S, Len(S) - 11): End If
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then
T2 = Left(S, 8)
S = Right(S, Len(S) - 11): End If: End If
i = InStr(1, S, "USA")
C1 = Left(S, i - 5): S1 = Mid(S, i - 3, 2)
S = Right(S, Len(S) - i - 3)
D3 = Left(S, 10): S = Right(S, Len(S) - 11)
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then T3 = Left(S, 8)
Else
D4 = Left(S, 10): End If: S = Right(S, Len(S) - 11)
If D4 = 0 Then
D4 = Left(S, 10): S = Right(S, Len(S) - 11): End If
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then
T4 = Left(S, 8)
S = Right(S, Len(S) - 11): End If: End If
C2 = S
ActiveCell.Offset(0, 1) = D1: ActiveCell.Offset(0, 2) = T1
ActiveCell.Offset(0, 3) = D2: ActiveCell.Offset(0, 4) = T2
ActiveCell.Offset(0, 5) = C1: ActiveCell.Offset(0, 6) = S1
ActiveCell.Offset(0, 7) = D3: ActiveCell.Offset(0, 8) = T3
ActiveCell.Offset(0, 9) = D4: ActiveCell.Offset(0, 10) = T4
ActiveCell.Offset(0, 11) = C2: ActiveCell.Offset(0, 12) = S2
ActiveCell.Offset(1, 0).Select
CParse
End Sub

And - You're welcome!

**KillerBug** · 03-17-2013, 10:56 PM

Awesome...I never knew Excel had such features built in. Your new code gives error 28 after 349 lines, but I sorted it and it works good...I expected it to fail at 6980 lines, but it worked fine on a test of 11,000 lines...and that's several times the largest sheet I've gotten so far.

Sub MegaParse():
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
CParse
MegaParse
End Sub


Sub CParse(): Dim S As String, i As Integer
Dim D1 As Date, T1 As Date, D2 As Date, T2 As Date
Dim C1 As String, S1 As String, D3 As Date, T3 As Date
Dim D4 As Date, T4 As Date, C2 As String, S2 As String
If ActiveCell = "" Then Exit Sub
S = ActiveCell
S2 = Right(S, 6): S2 = Left(S2, 2): S = Left(S, Len(S) - 6)
D1 = Left(S, 10): S = Right(S, Len(S) - 11)
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then T1 = Left(S, 8)
Else
D2 = Left(S, 10): End If: S = Right(S, Len(S) - 11)
If D2 = 0 Then
D2 = Left(S, 10): S = Right(S, Len(S) - 11): End If
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then
T2 = Left(S, 8)
S = Right(S, Len(S) - 11): End If: End If
i = InStr(1, S, "USA")
C1 = Left(S, i - 5): S1 = Mid(S, i - 3, 2)
S = Right(S, Len(S) - i - 3)
D3 = Left(S, 10): S = Right(S, Len(S) - 11)
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then T3 = Left(S, 8)
Else
D4 = Left(S, 10): End If: S = Right(S, Len(S) - 11)
If D4 = 0 Then
D4 = Left(S, 10): S = Right(S, Len(S) - 11): End If
If IsDate(Left(S, 8)) Then
If Mid(S, 3, 1) = ":" Then
T4 = Left(S, 8)
S = Right(S, Len(S) - 11): End If: End If
C2 = S
ActiveCell.Offset(0, 1) = D1: ActiveCell.Offset(0, 2) = T1
ActiveCell.Offset(0, 3) = D2: ActiveCell.Offset(0, 4) = T2
ActiveCell.Offset(0, 5) = C1: ActiveCell.Offset(0, 6) = S1
ActiveCell.Offset(0, 7) = D3: ActiveCell.Offset(0, 8) = T3
ActiveCell.Offset(0, 9) = D4: ActiveCell.Offset(0, 10) = T4
ActiveCell.Offset(0, 11) = C2: ActiveCell.Offset(0, 12) = S2
ActiveCell.Offset(1, 0).Select
End Sub