Thread: Make one line from Many

You can do it this way. Copy your text into the first column of an Excel spreadsheet.

Then run the following macro

Code:

Sub Reformat()
For N = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    'Check if first line of set - 2 uppercase letters followed by space and an uppercase followed by a lowercase letter
    If Len(Cells(N, 1)) >= 5 Then
        If IsUpperCase(Left(Cells(N, 1), 1)) And IsUpperCase(Mid(Cells(N, 1), 2, 1)) And Mid(Cells(N, 1), 3, 1) = " " And IsUpperCase(Mid(Cells(N, 1), 4, 1)) And IsLowerCase(Mid(Cells(N, 1), 5, 1)) Then
            FirstLine = True
        Else
            FirstLine = False
        End If
    Else
        FirstLine = False
    End If
    If FirstLine = True Then
        Cells(Rows.Count, 3).End(xlUp).Offset(1, 0) = Cells(N, 1)
    Else
        Cells(Rows.Count, 3).End(xlUp) = Cells(Rows.Count, 3).End(xlUp) & Cells(N, 1)
    End If
Next N

For N = 2 To Cells(Rows.Count, 3).End(xlUp).Row
    Cells(N, 4) = Left(Cells(N, 3), 2)
    
    'Find first number
    For M = 5 To Len(Cells(N, 3))
        If IsNumeric(Mid(Cells(N, 3), M, 1)) Then Exit For
    Next M
    
    Cells(N, 5) = Mid(Cells(N, 3), 4, M - 5) 'City
    
    For P = M To Len(Cells(N, 3))
        If IsNumeric(Mid(Cells(N, 3), M, P - M + 1)) = False Then Exit For
    Next P

    Cells(N, 6) = Mid(Cells(N, 3), M, P - M - 1) 'Frequency
    
    For S = P + 1 To Len(Cells(N, 3))
        If Mid(Cells(N, 3), S, 1) = " " Then Exit For
    Next S
    Cells(N, 7) = Mid(Cells(N, 3), P, S - P)
    Cells(N, 8) = Mid(Cells(N, 3), S + 1)
Next N


End Sub


Function IsUpperCase(TestCharacter) As Boolean
If Asc(TestCharacter) >= 65 And Asc(TestCharacter) <= 90 Then
    IsUpperCase = True
Else
    IsUpperCase = False
End If
End Function

Function IsLowerCase(TestCharacter) As Boolean
If Asc(TestCharacter) >= 97 And Asc(TestCharacter) <= 122 Then
    IsLowerCase = True
Else
    IsLowerCase = False
End If
End Function

Open up the VBA editor by hitting ALT F11

Insert a new module by hitting Insert - Module

Paste the macro into the empty sheet

Hit ALT F11 to get back to the worksheet.

Run the macro by going to tools-macro in Excel 2003 or the view ribbon in Excel 2007.

You can then save the output tab separated and open in Word as needed.