Option Explicit
Sub StealingAPrintoutWithBarsButNotStars()
'
' constants
Const ksFile = "x:...file.txt"
Const ksWS = "Sheet1"
Const kiRecordsTitles = 2
Const kiRecordsData = 7
'
' declarations
Dim I As Long, J As Long, K As Long, A As String, B As String
'
' start
' text
I = FreeFile()
Open ksFile For Input As #I
J = 0
' workbook
With Worksheets(ksWS)
Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
End With
'
' process
With Worksheets(ksWS)
Do While Not EOF(I)
Line Input #I, A
J = J + 1
K = Int(((J - kiRecordsTitles) + kiRecordsData - 1) / kiRecordsData) + 1
Select Case ((J - kiRecordsTitles) Mod kiRecordsData)
Case 0, 1 ' empty, underscores
Case 2 ' name, age, charges
' name
B = Left(A, 40)
.Cells(K, 1).Value = Trim(Left(B, InStr(B, ",") - 1))
.Cells(K, 2).Value = Trim(Right(B, Len(B) - InStr(B, ",")))
' age
.Cells(K, 3).Value = Val(Mid(A, 41, 5))
' charges
.Cells(K, 4).Value = Mid(A, 107, 20)
Case 3 ' charges
' charges
.Cells(K, 4).Value = .Cells(K, 4).Value & vbLf & Mid(A, 107, 20)
Case 4 ' address, charges
' address
.Cells(K, 5).Value = Left(A, 40)
' charges
.Cells(K, 4).Value = .Cells(K, 4).Value & vbLf & Mid(A, 107, 20)
Case 5 ' address, state, zip code, charges
' address
.Cells(K, 5).Value = .Cells(K, 5).Value & vbLf & Left(A, 17)
' state
.Cells(K, 6).Value = Mid(A, 19, 2)
' zip code
.Cells(K, 7).Value = Val(Mid(A, 23, 5))
' charges
.Cells(K, 4).Value = .Cells(K, 4).Value & vbLf & Mid(A, 107, 20)
Case 6 ' bail
.Cells(K, 8).Value = Val(Mid(A, 96, 23))
End Select
Loop
End With
'
' end
' text
Close #I
' workbook
ActiveWorkbook.Save
' beep
Beep
'
End Sub
