Help with macro. Import text file (fixed width)

[Sinner]

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).

 

[Dick Kusleika]

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

 

[Per Jessen]

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

 

[Per Jessen]

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

 

[Sinner]

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


Change your StartRow argument to StartRow:=9


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

Dear Kusleika,

It says Compile error: Expected Function or variable.

 

[Sinner]

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
"Per Jessen" <[email protected]> skrev i meddelelsen








- 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.

 

[Per Jessen]

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

"Sinner" <[email protected]> skrev i meddelelsen

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
"Per Jessen" <[email protected]> skrev i
meddelelsen

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.