VBA Code to Extract Specific Data Ordered by columns from TXT File into Excel

[Gianpaolo]

Hi to Everybody,
Have a .txt file that contains specific data that needs to be extracted and placed into corresponding columns in Excel. I'm New to VBA coding so having difficulty in making this work... and I don't Know what to do.
In the Excel file I need to import my text file in like this



To this in EXCEL divided by Columns



Attached a sample txt file to be processed.

Appreciate any help with this... many thanks in advance.

 

[vletm]

Gianpaolo
You should able to send
#1 a sample of Your txt -file
as well as
#2 a sample of expected extracted Excel-file here
base Your sample txt-file.

 

[Gianpaolo]

Here attached the original txt FILE

Gianpaolo
You should able to send
#1 a sample of Your txt -file
as well as
#2 a sample of expected extracted Excel-file here
base Your sample txt-file.

Have attached the originale txt file to be processed and the expected excel output file

 

[vletm]

Gianpaolo
Your expected excel output.xlsx seems to be different than in Your original layout
... which one is correct?
You could get Your #1 version with Macro Recorder.
Take care that those two Array's are like in next code.
If You try to use below code,
then You have to modify Your used path and file-name there.

Sub Gianpaolo()
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;MODIFY_HERE_YOUR_TEXT-FILE_NAME_WITH_FULL_PATH", Destination:=Range("$A$1"))
        .Name = "Sample_2"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .RefreshPeriod = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 10000
        .TextFileStartRow = 6
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(14, 10, 15, 15, 6, 18, 6, 11, 10, 16)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[Gianpaolo]

Hi, thanks for your reply..
the one which is correct is my expected excel output.xls

I know that I could get the result with macro recorderer, but as my file is too big an error occours due to many elements.

"
too many row continuations

"
have attached the original file named "FILE.TXT" so you can try with macro recorderer and verify what happened

 

[vletm]

Gianpaolo
Seems You didn't use my code ...
This sample file should give Your 2nd version of output by pressing [ Do It ]-button.
It uses my the 1st code. I added some more features, because Your two versions.
Note: There is like 'missing', I cool it - Note 15 information ... as You didn't want it.

 

[Marc L]

Hi, according to the post #3 attachment an Excel basics VBA demonstration as a beginner starter :​

Sub Demo1()
    With Application
         V = .GetOpenFilename("70's print text file, *.txt"):  If V = False Then Exit Sub
        .ScreenUpdating = False
         Workbooks.OpenText V, , 7, 2, FieldInfo:=Array([{0,1}], [{14,1}], [{24,1}], [{39,1}], [{54,1}], _
                            [{60,1}], [{78,1}], [{84,1}], [{95,1}], [{106,1}]), DecimalSeparator:=","
    With ActiveSheet.UsedRange.Columns
        .Item(9).SpecialCells(2, 2).EntireRow.Delete
        .Item(9).SpecialCells(4).EntireRow.Delete
         Union(.Item(1), .Item("C:D"), .Item(6), .Item(10)).Columns.AutoFit
    End With
        .DisplayAlerts = False
         ActiveWorkbook.SaveAs Replace(ActiveWorkbook.Name, ".txt", " .xlsx"), 51
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[Marc L]

Gianpaolo, OpenText codeline updated (8 to 7) to avoid a SpecialCells crash in case the print text file has only a single page …​

​

 

[vletm]

Gianpaolo
If You would like to get all data from text-file then test that below button.

 

[Gianpaolo]

Thanks, thanks to Marc L and Vletm for yours help!! no words!! "70's print text files" works fine and also Gianpaolo.xlsb do the job.

 

[Gianpaolo]

Gianpaolo, OpenText codeline updated (8 to 7) to avoid a SpecialCells crash in case the print text file has only a single page …​

​

Hi Marc, What I can do if I want to open it in a contiguous worksheet named for example "IMPORTED DATA"?

I have noticed that when I open my file VBA script import it and open a new WORKBOOK with the name of the file

Where " Sheet 1" is the main sheet and "Imported Data" is the destination sheet on the same workbook

 

[Marc L]

Yes 'cause I couldn't guess what you exactly need according to the missing information of your initial post …​

So one possible way is to load the data via an Excel QueryTable like vletm did in post #4 rather than my OpenText method​

then still use my both SpecialCells codelines to clean the data …​

​

 

[Gianpaolo]

Yes 'cause I couldn't guess what you exactly need according to the missing information of your initial post …​

So one possible way is to load the data via an Excel QueryTable like vletm did in post #4 rather than my OpenText method​

then still use my both SpecialCells codelines to clean the data …​

​

Hi Marc,
have created this

Where I have to put this?

>>Sheets.Add.Name = "Import Data" <<

Private Sub Gianpaolo_3()
         Workbooks.OpenText V, , 7, 2, FieldInfo:=Array([{0,1}], [{14,1}], [{24,1}], [{39,1}], [{54,1}], _
                            [{60,1}], [{78,1}], [{84,1}], [{95,1}], [{106,1}]), DecimalSeparator:=","
    With ActiveSheet.UsedRange.Columns
        .Item(9).SpecialCells(2, 2).EntireRow.Delete
        .Item(9).SpecialCells(4).EntireRow.Delete
         Union(.Item(1), .Item("C:D"), .Item(6), .Item(10)).Columns.AutoFit
    End With
   
End Sub

 

[Marc L]

According to your previous post attachment :​

• on VBE side delete first the useless Modulo1.
  
  
• Paste this new starter Excel basics VBA demonstration only to the Foglio1 worksheet module :

Sub Demo2()
        UsedRange.Clear
        V = Application.GetOpenFilename("70's print text file, *.txt"):  If V = False Then Exit Sub
        Application.ScreenUpdating = False
    With QueryTables.Add("TEXT;" & V, [A1])
        .AdjustColumnWidth = True
        .RefreshStyle = 0
        .TextFileDecimalSeparator = ","
        .TextFileFixedColumnWidths = [{14,10,15,15,6,18,6,11,11}]
        .TextFileParseType = 2
        .TextFileStartRow = 7
        .TextFileTextQualifier = xlTextQualifierNone
        .Refresh False
        .Delete
    End With
        UsedRange.Columns(9).SpecialCells(2, 2).EntireRow.Delete
        UsedRange.Columns(9).SpecialCells(4).EntireRow.Delete
        Application.Goto [A1], True
        Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​