[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 551
  • Last Modified:

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..
0
Shums
Asked:
Shums
  • 12
  • 10
1 Solution
 
Arno KosterCommented:
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

0
 
Arno KosterCommented:
2) without data files I cannot determine which columns hold the Dr, Cr & Net values. please supply this information !
0
 
Arno KosterCommented:
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

or
range("1:1").Insert

Open in new window

0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Arno KosterCommented:
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

0
 
ShumsAsst. Financial ControllerAuthor Commented:
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
0
 
Arno KosterCommented:
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

0
 
ShumsAsst. Financial ControllerAuthor Commented:
Thanks again Akoster,

Its debug at line 66 "content.Rows("1:1").AutoFilter field:=6, Criteria1:="OTHER REVENUE"
0
 
ShumsAsst. Financial ControllerAuthor Commented:
Sorry Akoster,

Its debug at line 67 "content.UsedRange.Offset(1).Delete shift:=xlUp"
0
 
ShumsAsst. Financial ControllerAuthor Commented:
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....
0
 
Arno KosterCommented:
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

0
 
Arno KosterCommented:
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

0
 
Arno KosterCommented:
and please change this line
'-- keep only other revenue types

Open in new window

to
'-- 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

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

Open in new window

0
 
ShumsAsst. Financial ControllerAuthor Commented:
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).
0
 
Arno KosterCommented:
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


to

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
0
 
ShumsAsst. Financial ControllerAuthor Commented:
Thanks a million Akoster sir.

Please guide me in stupid thing, how to make subtotal row bold. :)
0
 
ShumsAsst. Financial ControllerAuthor Commented:
Oh Sorry Mr. Akoster,

I did it as ws.Range("G" & LastRow2 + 1).Font.bold = True
0
 
Arno KosterCommented:
to make the complete row bold, use
ws.Rows(LastRow2 + 1).Font.Bold = True

Open in new window

to make only the subtotals bold, use
ws.Range("G" & LastRow2 + 1 & ":I" & LastRow2+1).Font.Bold = True

Open in new window

0
 
ShumsAsst. Financial ControllerAuthor Commented:
Mr. Akoster has changed my old stupid vba to advanced wizard vba. I am so grateful to him, I can't express.
0
 
ShumsAsst. Financial ControllerAuthor Commented:
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......
0
 
Arno KosterCommented:
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


or

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

Open in new window

0
 
ShumsAsst. Financial ControllerAuthor Commented:
Thanks Mr. Akoster,

It working perfect......

God Bless You.....
0
 
Arno KosterCommented:
You're welcome !
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 12
  • 10
Tackle projects and never again get stuck behind a technical roadblock.
Join Now