Extract data having each record in two lines from text file format into excel format
- Thread starter mohsin
- Start date
- Joined
- Dec 16, 2012
- Messages
- 2,319
- Reaction score
- 40
- Points
- 48
- Excel Version(s)
- 365
The following macro works well with your sample file but may not on others.
It uses
(a) the presence of a number in the first column
or
(b) the presence of a recognisable date in characters 28 to 36 of a line
to determine if a line of the text file is to be processed.
It puts the results on the active sheet, using column A to decide how far down to put the results.
See also attached file which has a button to click.
It uses
(a) the presence of a number in the first column
or
(b) the presence of a recognisable date in characters 28 to 36 of a line
to determine if a line of the text file is to be processed.
It puts the results on the active sheet, using column A to decide how far down to put the results.
See also attached file which has a button to click.
Code:
Sub blah()
Dim results(0 To 16)
Dim fn
fn = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fn = False Then
MsgBox "Nothing Chosen"
Else
FileNo = FreeFile
Open fn For Input Access Read As #FileNo
lrw = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 2
headers = Array("PO Number-Release", "Line", "Currency", "Line Type", "Category", "Item", "Rev", "Description", "Shipment", "Date", "Unit Price", "Unit", "Quantity/Amount Ordered", "Quantity/Amount Received", "Quantity/Amount Billed", "Percent Due", "Closed Status")
Cells(lrw, 1).Resize(, UBound(headers) + 1) = headers: lrw = lrw + 1
Do While Not EOF(1)
Line Input #FileNo, aline
If IsNumeric(Left(aline, 1)) Then
Erase results
x = Split("1,19|21,4|26,4|35,8|45,10|66,20|87,3|91,42", "|")
For i = LBound(x) To UBound(x)
y = Split(x(i), ",")
results(i) = Application.Trim(Mid(aline, CLng(y(0)), CLng(y(1))))
Next i
Else
If IsDate(Mid(aline, 28, 9)) Then
x = Split("18,9|28,9|38,15|54,8|63,15|79,15|95,15|111,7|119,14", "|")
For i = LBound(x) To UBound(x)
y = Split(x(i), ",")
results(8 + i) = Application.Trim(Mid(aline, CLng(y(0)), CLng(y(1))))
Next i
Cells(lrw, 1).Resize(, UBound(results) + 1).Value = results: lrw = lrw + 1
End If
End If
Loop
Close #FileNo
End If
End Sub