asked on

Text Import Wizard In Excel

Hi All,

I am receiving a text file every month, I need to change their name to work as per below code to extract data.

Sub FileExtract()

    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Application.DisplayAlerts = False
    
    Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ClearContents
    Range("A5").Select
    Workbooks.OpenText filename:= _
        "C:\Account Recon\CommData.Txt" _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(56, 1), _
        Array(64, 1), Array(68, 1), Array(98, 1), Array(111, 1), Array(124, 1), Array(137, 1), _
        Array(142, 1), Array(155, 1), Array(160, 1), Array(185, 1), Array(191, 1), Array(199, 1), _
        Array(224, 1), Array(227, 1), Array(231, 1), Array(234, 1), Array(238, 1), Array(240, 1), _
        Array(245, 1), Array(247, 1), Array(261, 1), Array(270, 1), Array(290, 1), Array(296, 1), _
        Array(309, 1), Array(321, 1), Array(332, 1), Array(336, 1), Array(341, 1), Array(344, 1), _
        Array(386, 1), Array(408, 1), Array(472, 1), Array(526, 1), Array(536, 1), Array(576, 1), _
        Array(599, 1), Array(645, 1), Array(666, 1)), TrailingMinusNumbers:=True
    ActiveSheet.Select
    Range("A1").Select
    Selection.EntireRow.Insert
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "Type"
    Columns("AJ:AJ").Select
    Selection.AutoFilter
    Range("AJ1").Select
    Selection.AutoFilter Field:=1, Criteria1:="=*total*", Operator:=xlAnd
    Rows("3:3").Select
    Range("AJ3").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Selection.End(xlUp).Select
    Selection.AutoFilter Field:=1
    Selection.End(xlToLeft).Select
    Range("F2").Select
    Selection.EntireColumn.Insert
    Range("F2").Select
    LastRow1 = Cells(Rows.Count, "P").End(xlUp).Row
    Range("F2:F" & LastRow1).Formula = "=VLOOKUP(RC[-1],'[CommCalc.xls]Account-Type'!C1:C2,2,0)"
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.End(xlUp).Select
    Range("F2").Select
    Rows("2:2").Select
    Range("F2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Corp"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Area"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Acct"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Type"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "PCNT"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Cust.No."
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Inv.No."
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "Vessels"
    Rows("1:1").Select
    Range("AJ1").Activate
    Selection.AutoFilter
    Rows("1:1").Select
    Selection.AutoFilter
    Range("F1").Select
    Selection.AutoFilter Field:=6, Criteria1:="<>*revenue*", Operator:=xlAnd
    Rows("2:2").Select
    Range("F2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Range("F1").Select
    Selection.AutoFilter Field:=6
    Range("F1").Select
    Selection.AutoFilter Field:=6, Criteria1:="OTHER REVENUE"
    Rows("2:2").Select
    Range("F2").Activate
    Selection.Delete Shift:=xlUp
    Range("F1").Select
    Selection.AutoFilter Field:=6
    Range("F2").Select
    Windows("CommData.Txt").Activate
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("G2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("AJ2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("F5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("J2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("N2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("J5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Range("P2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("K5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("CommData.Txt").Activate
    Columns("AV").ClearContents
    Range("AV2:AV" & LastRow1).Formula = "=CONCATENATE(RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2])"
    Range("AV2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Windows("CommCalc.xls").Activate
    Range("L5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I5").Select
    LastRow2 = Cells(Rows.Count, "H").End(xlUp).Row
    Range("I5:I" & LastRow2).Formula = "=H5-G5"
    Range("A5").Select
    Windows("CommData.Txt").Activate
    ActiveWorkbook.Close False
    Application.DisplayAlerts = True
End Sub

Open in new window

1) I would like to have an option to select which text file to extract and proceed for formulation and formatting.
2) I would like to add SubTotal at the bottom for Dr, Cr & Net columns after summary is finalized in their respective columns.

Please advice..

Arno Koster

1) You can use this macro code:

[...]
result = Application.GetOpenFilename(FileFilter:="Monthly Data files, *.txt", Title:="Please select a file")
if result <> false then Workbooks.OpenText filename:= result,  Origin:=437, [...]

Open in new window

Arno Koster

2) without data files I cannot determine which columns hold the Dr, Cr & Net values. please supply this information !

Arno Koster

3) please clean up your code to make it more easy to read & manage by getting rid of all 'selection' statements:

e.g. replace

Range("A1").Select
Selection.EntireRow.Insert

Open in new window

with

range("A1").EntireRow.Insert

Open in new window

range("1:1").Insert

Open in new window

Arno Koster

also, assuming that the first row does not contain formulae, replace

Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.End(xlUp).Select

Open in new window

with

range("F:F").copy
Range("F:F").PasteSpecial xlPasteValues

Open in new window

Shums Faruk

ASKER

Thanks Akoster,

I attached a sample file and its text file for your reference. Please incorporate with above codes.

See what else you can improvise to make it shorter and on one click.
CommCalc.xls
CommData.Txt

Arno Koster

the result would be

Sub FileExtract()
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim ws As Worksheet
Dim content As Worksheet
Dim result As String
Dim data_range As String

    Application.DisplayAlerts = False
    
    '-- this code is placed in a module, so first make sure that we are working on the summary sheet.
    Set ws = Worksheets("summary")
    ws.Select
    
    '-- clear data cells
    data_range = Replace(ws.UsedRange.Address, "$A$1", "A5")
    Range(data_range).ClearContents
    
    '-- select data file
    result = Application.GetOpenFilename(FileFilter:="Monthly Data files, *.txt", Title:="Please select a file")
    If result <> CStr(False) Then Workbooks.OpenText filename:=result _
        , Origin:=437, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array( _
        Array(0, 1), Array(40, 1), Array(46, 1), Array(52, 1), Array(56, 1), _
        Array(64, 1), Array(68, 1), Array(98, 1), Array(111, 1), Array(124, 1), Array(137, 1), _
        Array(142, 1), Array(155, 1), Array(160, 1), Array(185, 1), Array(191, 1), Array(199, 1), _
        Array(224, 1), Array(227, 1), Array(231, 1), Array(234, 1), Array(238, 1), Array(240, 1), _
        Array(245, 1), Array(247, 1), Array(261, 1), Array(270, 1), Array(290, 1), Array(296, 1), _
        Array(309, 1), Array(321, 1), Array(332, 1), Array(336, 1), Array(341, 1), Array(344, 1), _
        Array(386, 1), Array(408, 1), Array(472, 1), Array(526, 1), Array(536, 1), Array(576, 1), _
        Array(599, 1), Array(645, 1), Array(666, 1)), TrailingMinusNumbers:=True
    Set content = ActiveSheet
    
    '-- add headers
    content.Range("A1").EntireRow.Insert
    content.Range("F:F").Insert
    content.Range("C1") = "Corp"
    content.Range("D1") = "Area"
    content.Range("E1") = "Acct"
    content.Range("F1") = "Type"
    content.Range("G1") = "PCNT"
    content.Range("N1") = "Cust.No."
    content.Range("P1") = "Inv.No."
    content.Range("AJ1") = "Vessels"
    content.Range("AJ1") = "Type"
    
    '-- remove totals from column AJ
    content.Columns("AJ:AJ").AutoFilter
    content.Rows("1:1").AutoFilter field:=1, Criteria1:="=*total*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- insert account type lookup formulae
    LastRow1 = Cells(Rows.Count, "P").End(xlUp).Row
    content.Range("F2:F" & LastRow1).Formula = "=VLOOKUP(RC[-1],'[CommCalc.xls]Account-Type'!C1:C2,2,0)"
    content.Range("F:F").Copy
    content.Range("F:F").PasteSpecial xlPasteValues
    
    '-- sort data
    content.UsedRange.Sort key1:=Range("F2"), order1:=xlAscending, Header:=xlYes
           
    '-- keep only revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="<>*revenue*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="OTHER REVENUE"
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter

    '-- add vessel name row
    content.Columns("AV").ClearContents
    content.Range("AV2:AV" & LastRow1).Formula = "=CONCATENATE(RC[-12],RC[-11],RC[-10],RC[-9],RC[-8],RC[-7],RC[-6],RC[-5],RC[-4],RC[-3],RC[-2])"
    content.Columns("AV").Copy
    content.Columns("AV").PasteSpecial xlPasteValues

    '-- copy remaining data
    content.UsedRange.Offset(1).Columns(5).Copy ws.Range("A5")
    content.UsedRange.Offset(1).Columns(3).Copy ws.Range("B5")
    content.UsedRange.Offset(1).Columns(4).Copy ws.Range("C5")
    content.UsedRange.Offset(1).Columns(7).Copy ws.Range("D5")
    content.UsedRange.Offset(1).Columns(36).Copy ws.Range("E5")
    content.UsedRange.Offset(1).Columns(6).Copy ws.Range("F5")
    content.UsedRange.Offset(1).Columns(9).Copy ws.Range("G5")
    content.UsedRange.Offset(1).Columns(10).Copy ws.Range("H5")
    content.UsedRange.Offset(1).Columns(14).Copy ws.Range("J5")
    content.UsedRange.Offset(1).Columns(16).Copy ws.Range("K5")
    content.UsedRange.Offset(1).Columns(48).Copy ws.Range("L5")
    
    '-- add function
    ws.Range("I5:I" & ws.UsedRange.Rows.Count).Formula = "=H5-G5"
        
    '-- close data file
    content.Parent.Close False
    Application.DisplayAlerts = True
    MsgBox "Completed Consolidating Data"
End Sub

Open in new window

Shums Faruk

ASKER

Thanks again Akoster,

Its debug at line 66 "content.Rows("1:1").AutoFilter field:=6, Criteria1:="OTHER REVENUE"

Shums Faruk

ASKER

Sorry Akoster,

Its debug at line 67 "content.UsedRange.Offset(1).Delete shift:=xlUp"

Shums Faruk

ASKER

Hi Mr. Akoster,

I edited your above code from:

    '-- keep only revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="<>*revenue*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="OTHER REVENUE"
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter

Open in new window

To:

    '-- keep only revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="<>*revenue*", Operator:=xlAnd
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter
    
    '-- keep only other revenue types
    content.Rows("1:1").AutoFilter
    content.Rows("1:1").AutoFilter field:=6, Criteria1:="OTHER REVENUE"
    content.UsedRange.Offset(1).Delete shift:=xlUp
    content.Rows("1:1").AutoFilter

Open in new window

Its working perfectly fine.....

Now at the end of your code:

'-- add function
    ws.Range("I5:I" & ws.UsedRange.Rows.Count).Formula = "=H5-G5"

Open in new window

It copies this formula to some more rows in column "I", I tried to change it to refer LastRow2, but it gives error. Please help....

Lastly I would like to have Subtotal at the column "G"(Dr), "H"(Cr) & "I"(Net).

Thanking you in advance....

Arno Koster

Shums,

glad to see that at least the debug problem has been solved.

using Lastrow2 indeed is possible, the problem is that the lastrow2 value is not (yet) calculated in the code. you should thus put the line calculating lastrow2 back in the code:

LastRow2 = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
ws.Range("I5:I" & LastRow2).Formula = "=H5-G5"

Open in new window

Arno Koster

for the subtotals, add these lines just beneath the H5-G5 formula line:

ws.Range("G" & LastRow2 + 1).Formula = "=SUM(G5:G" & LastRow2 & ")"
ws.Range("H" & LastRow2 + 1).Formula = "=SUM(H5:H" & LastRow2 & ")"
ws.Range("I" & LastRow2 + 1).Formula = "=SUM(I5:I" & LastRow2 & ")"

Open in new window

Arno Koster

and please change this line

'-- keep only other revenue types

Open in new window

'-- delete other revenue types

Open in new window

because that's what going on.

In order to prevent corrupting worksheets that might also be opened, please change

Set content = ActiveSheet

Open in new window

DoEvents
Set content = Workbooks(Mid(result, InStrRev(result, "\") + 1)).ActiveSheet

Open in new window

Shums Faruk

ASKER

Akoster,

Obviously we can't refer column "I" as for LastRow2 value for the same column I changed it as per below:

LastRow2 = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ws.Range("I5:I" & LastRow2).Formula = "=H5-G5"

Open in new window

Bravo....

I am bit confused, when we command to clear content at the beginning, why its clearing the format too, after finish I have to change its format again.

Lastly please advice me to add subtotal at the end for column "G"(Dr), "H"(Cr) & "I"(Net).

Arno Koster

that's true, i updated my post to reference lastrow2 to the "G" column. the "A" column will do fine as well.

As for the formatting, we are now copying complete columns. this by default means copying content and formatting.

If you want only the content, you could change

content.UsedRange.Offset(1).Columns(5).Copy ws.Range("A5")

Open in new window

content.UsedRange.Offset(1).Columns(5).Copy
ws.range("A5").pastespecial xlValues

Open in new window

and of course update all other content copy lines beneath it

for the subtotals, look at comment 38300568

Shums Faruk

ASKER

Thanks a million Akoster sir.

Please guide me in stupid thing, how to make subtotal row bold. :)

Shums Faruk

ASKER

Oh Sorry Mr. Akoster,

I did it as ws.Range("G" & LastRow2 + 1).Font.bold = True

ASKER CERTIFIED SOLUTION

Arno Koster

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Shums Faruk

ASKER

Mr. Akoster has changed my old stupid vba to advanced wizard vba. I am so grateful to him, I can't express.

Shums Faruk

ASKER

Mr. Akoster,

I am trying to add autofilter at the end result, but it disturbs format of active sheet. Code as below:

ws.Range("A4:L" & LastRow2).AutoFilter Field:=1, Criteria1:="=*maintenance*", Operator:= _
        xlOr, Criteria2:="=*taut*"
    ws.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    AutoFilterMode = False

Open in new window

I want to add this criteria for Column "L", but seems usedrange is too long for that column.

Please help......

Arno Koster

if you want to filter on contents in column "L", you should use either

ws.Range("L4:L" & LastRow2).AutoFilter Field:=1, Criteria1:="=*maintenance*", Operator:= xlOr, Criteria2:="=*taut*"

Open in new window

ws.Range("A4:L" & LastRow2).AutoFilter Field:=12, Criteria1:="=*maintenance*", Operator:= xlOr, Criteria2:="=*taut*"

Open in new window

Shums Faruk

ASKER

Thanks Mr. Akoster,

It working perfect......

God Bless You.....

Arno Koster

You're welcome !