Help with macro. Import text file (fixed width)
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" skrev i meddelelsen
...
On Mar 25, 1:40 am, "Per Jessen" wrote:
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" skrev i
. gbl...
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
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.
|