Help with macro. Import text file (fixed width)

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Sinner - 24 Mar 2008 19:34 GMT

Hello,

I have the following macro to import a text file (fixed width).

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 24/03/2008 by
'

'
ChDir "C:\Documents and Settings\rambo\Desktop\ST ReCON"
Workbooks.OpenText Filename:= _
"C:\Documents and Settings\rambo\Desktop\ST ReCON\STS 24.TXT",
Origin:= _
437, StartRow:=1, DataType:=xlFixedWidth,
FieldInfo:=Array(Array(0, 1), _
Array(30, 2), Array(42, 1), Array(56, 1), Array(90, 1),
Array(140, 1)), _
TrailingMinusNumbers:=True
Cells.Select
Selection.Columns.AutoFit
ActiveWindow.Zoom = 85

End Sub

Things I want to add are:
- Simple button in sheet to start macro
- Ask for text file destination folder
- Delete first 8 rows
- Delete row with 4 or more character '----'
- Delete row with word containing total
- Delete row with 4 or more character '===='
- All data asending order with respect to columnC (entire data & not
just columnC).

Reply to this Message

Dick Kusleika - 24 Mar 2008 21:06 GMT

>Things I want to add are:
>- Simple button in sheet to start macro

Show the Forms toolbar. Drag a commandbutton onto your sheet. Assign
Macro1.

>- Ask for text file destination folder

http://www.dailydoseofexcel.com/archives/2004/06/09/getopenfilename/

>- Delete first 8 rows

Change your StartRow argument to StartRow:=9

>- Delete row with 4 or more character '----'
>- Delete row with word containing total
>- Delete row with 4 or more character '===='
>- All data asending order with respect to columnC (entire data & not
>just columnC).

Untested, but should work

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 24/03/2008 by
'

'
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim i As Long

Const sDASH As String = "----"
Const sEQUAL As String = "===="
Const sTOTAL As String = "Total"

Set wb = Workbooks.OpenText(Filename:= _
"C:\Documents and Settings\rambo\Desktop\ST ReCON\STS 24.TXT",
Origin:= _
437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0,
1), _
Array(30, 2), Array(42, 1), Array(56, 1), Array(90, 1), Array(140,
1)), _
TrailingMinusNumbers:=True)
Set ws = wb.Sheets(1)
Set rng = Intersect(ws.Columns(1), ws.UsedRange)

For i = rng.Cells(rng.Cells.Count).Row To 1 Step -1
If InStr(1, rng.Cells(i).Value, sDASH) > 0 Or _
InStr(1, rng.Cells(i).Value, sEQUAL) > 0 Or _
InStr(1, rng.Cells(i).Value, sTOTAL) > 0 Then

rng.Cells(i).EntireRow.Delete
End If
Next i

ws.UsedRange.Sort ws.Range("C1"), xlAscending, , , , , , xlNo
ws.UsedRange.Columns.AutoFit
ActiveWindow.Zoom = 85

End Sub

Signature

Dick Kusleika
Microsoft MVP-Excel
http://www.dailydoseofexcel.com

Reply to this Message

Sinner - 24 Mar 2008 22:35 GMT

> >Things I want to add are:
> >- Simple button in sheet to start macro
[quoted text clipped - 63 lines]
> Dick Kusleika
> Microsoft MVP-Excelhttp://www.dailydoseofexcel.com

Dear Kusleika,

It says Compile error: Expected Function or variable.

Reply to this Message

Per Jessen - 24 Mar 2008 21:36 GMT

Hi

Insert a CommandButton from the Control Toolbox menu, and hit "Exit Design
Mode"

On the codesheet for Sheet1 enter this code (or choose the sheet where the
command button is):

Private Sub CommandButton1_Click()
Call Macro1
End Sub

Put code below in an ordinary module. As I don't know i which row(s) to test
in order to determine rows to delete the code loops thru all cells with
data.

Sub TestMe
DestFile = Application.GetOpenFilename
Workbooks.OpenText Filename:=DestFile, Origin:=437, StartRow:=1,
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(30, 2), Array(42, 1), Array(56, 1),
Array(90, 1), _
Array(140, 1)), TrailingMinusNumbers:=True
Cells.Select
Selection.Columns.AutoFit
ActiveWindow.Zoom = 85
Rows("1:8").Delete
For Each c In Range("A1").CurrentRegion
If c.Value Like "----*" Then
c.Delete
ElseIf c.Value Like "*Total*" Then ' Case sensitive
c.Delete
ElseIf c.Value Like "====*" Then
c.Delete
End If
Next
Range("A1").CurrentRegion.Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Regards,

Per

> Hello,
>
[quoted text clipped - 31 lines]
> - All data asending order with respect to columnC (entire data & not
> just columnC).

Reply to this Message

Per Jessen - 24 Mar 2008 21:40 GMT

Just a little correction to the code:

Sub TestMe()

DestFile = Application.GetOpenFilename
Workbooks.OpenText Filename:=DestFile, Origin:=437, StartRow:=1,
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(30, 2), Array(42, 1), Array(56, 1),
Array(90, 1), _
Array(140, 1)), TrailingMinusNumbers:=True
Cells.Select
Selection.Columns.AutoFit
ActiveWindow.Zoom = 85
Rows("1:8").Delete
For Each c In Range("A1").CurrentRegion
If c.Value Like "----*" Then
c.EntireRow.Delete
ElseIf c.Value Like "*Total*" Then ' Case sensitive
c.EntireRow.Delete
ElseIf c.Value Like "====*" Then
c.EntireRow.Delete
End If
Next
Range("A1").CurrentRegion.Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

> Hi
>
[quoted text clipped - 76 lines]
>> - All data asending order with respect to columnC (entire data & not
>> just columnC).

Reply to this Message

Sinner - 25 Mar 2008 10:34 GMT

> Just a little correction to the code:
>
[quoted text clipped - 106 lines]
>
> - Show quoted text -

Dear PER,

Two things that need to fix.

- Incase a text file is not selected and we exit the macro, it should
not give arror message.
- The data sould import to same workbook. Worksheet name is SBL.
- The total is not being deleted. All values with word total are
consolidated at end of columnE. I like the cell wise loop which is
good since file doesn't have a delimiter and we have space as
delimiter. Total can come in any column. At the moment it comes in
columnE. Hope you can adjust accordingly. Suit yourself with what ever
approach you go ahead but rows with total need to be deleted.

Thanks.

Reply to this Message

Per Jessen - 25 Mar 2008 21:24 GMT

Hi Sinner

Thanks for your reply.

Here is a new code to test.

Using workbooks.opentext will import the file to a new workbook, so we
process the imported data then copy it to desired workbook and sheet.

Sub TestMe()
Dim ImportWbk As Workbook
Dim newWbk As Workbooks
Dim TestRow As Range

Set ImportWbk = ThisWorkbook

DestFile = Application.GetOpenFilename
If DestFile = False Then
msg = MsgBox("No file was selected." & vbLf & vbLf & "Macro terminate!",
vbCritical, "Best regards, Per Jessen")
Exit Sub
End If
On Error GoTo ErrHandler
Workbooks.OpenText Filename:=DestFile, Origin:=437, StartRow:=1,
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(30, 2), Array(42, 1), Array(56, 1),
Array(90, 1), _
Array(140, 1)), TrailingMinusNumbers:=True
On Error goto 0
Set newWbk = ActiveWorkbook

Cells.Select
Selection.Columns.AutoFit
ActiveWindow.Zoom = 85
Rows("1:8").Delete
Range("A1").CurrentRegion.Select
LastCol = Selection.Columns.Count
For r = Selection.Rows.Count To 1 Step -1
Set TestRow = Range(Cells(r, 1), Cells(r, LastCol))
TestRow.Select
For Each c In TestRow
If c.Value Like "----*" Then
c.EntireRow.Delete
Exit For
ElseIf c.Value Like "*Total*" Then
c.EntireRow.Delete
ElseIf c.Value Like "*total*" Then
c.EntireRow.Delete
ElseIf c.Value Like "====*" Then
c.EntireRow.Delete
End If
Next
Next
Range("A1").CurrentRegion.Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Selection.Copy
ActiveSheet.Paste Destination:=ImportWbk.Sheets("SBL").Range("A1")
newWbk.Close savechanges:=False
End

ErrHandler:
msg = MsgBox("No file was selected." & vbLf & vbLf & "Macro terminate!",
vbCritical, "Best regards, Per Jessen")
End Sub

Regards,

Per

On Mar 25, 1:40 am, "Per Jessen" <per.jes...@mail.dk> wrote:

> Just a little correction to the code:
>
[quoted text clipped - 73 lines]
>
> > Per

Reply to this Message