Macro to extract text from .txt file into Excel

striker359

Board Regular
Joined
Jun 19, 2014
Messages
64
Hi,

I'm completely new to macro building but here goes:

I would like to extract info from an external txt file into Excel. For example:

txt file:

/* ----------------- Dummy ------------------- */
JobName: Dummy
send_notifications: y
max_runs: 5


/* ----------------- TAF-O-FF401D ------------------- */
JobName: TAF-O-FF401D
send_notifications: y
max_runs: 5

I would require a way to read the item category (JobName, send_notifcations, max_runs), for lack of a better term, and then to populate the corresponding info into specific columns in Excel.

For example:

JobName (Dummy) in Column A
send_notifications (y) in Column B
max_runs (5) in Column C

With the /* ----------------- JobName ------------------- */ indicating a new job entry, I would require the next job entry to be on the next row and so on till there are no more job entries left.

Thanks in advance!
 
Last edited:
Thanks tyger... i'll give it a shot and get back to you

Code:
Sub CopyTextFile()


Worksheets.Add().Name = "PullSheet" 'Make the sheet for the data from txt file to go into


    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Tyger\Desktop\test2.txt", Destination:=Range("$A$1"))
        'Change Connection to your file location and Desitnation to where you want to paste
        .Name = "test2"  'Name of connection 
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


'Pull Sheet was Made  


'Now Begins Looping through data to move it to results sheet 



    
lastRowCOlA = Sheets("PullSheet").Range("A65536").End(xlUp).Row 'Finds he number of the last cell in Column A in Pullsheet


For Each Cell In Sheets("PullSheet").Range("A1", Range("A1").Offset(lastRowCOlA, 0))  'Sets to look in each cell in range of data in column A         

'Start Point 1

         lastRowCOlA = Sheets("Results").Range("A65536").End(xlUp).Row  ' Gets the next open cell in Colmn A of results page


        If Cell.Value = "insert_job:" Or Cell.Value = "update_job:" Then 'Checks if cell equals criteria if it doesn't skips to next cell
          JobName = Cell.Offset(0, 1).Value ' Sets JobName as the value of the cell one to the right 
             If JobName = "" Then   ' If the cell is blank
                    JobName = "NA"  ' change it from blank to NA IT MUST HAVE A VALUE NOT A BLANK
                End If   ' Stops First IF     
                   End If   ' Stops Second IF  
        Sheets("Results").Range("A" & lastRowCOlA + 1).Value = JobName  ' Puts JobName in next open cell in results  
        
' Ends looking in Job Names From Text File To Results Page 


' End Point 1  


' Starts checking if cell is equal to description 


'Start Point 2     
        LastRowColB = Sheets("Results").Range("B65536").End(xlUp).Row ' Find Next empty cell in column b of results 
                   If Cell.Value = "description:" Then 'Checks if cell equals criteria 
              Note = Cell.Offset(0, 1).Value 'Grabs value of cell one to the right
                                If Cell.Value = "" Then ' Checks if cell is blank IT CANNOT BE SO IF IT IS  
                                    Cell.Value = "Na"  ' Change Cell Value to NA to be pasted into results sheet and not mess up code to find next open cell 
                              End If
                                    End IF           
          Sheets("Results").Range("B" & LastRowColB + 1).Value = Note 'Inputs value into results page 
                
' Ends looking for Descrtiption 


'End Point 2


'Need to add more Start and End Points for each Tag in your Txt File 




    
Next ' Loops Back to check Next Cell in Column A    




' Since Jobtype is under a different column than all the other data need new for ecah statement 




LastRowCOlC = Sheets("PullSheet").Range("C65536").End(xlUp).Row ' Finds last cell in column c of pull sheet 


For Each Cell In Sheets("PullSheet").Range("C1", Range("C1").Offset(LastRowCOlC, 0)) 'Sets loop for all items in Colmn C
    lastRowCOlD = Sheets("Results").Range("D65536").End(xlUp).Row ' Sets next Blank row in Results sheet 
      If Cell.Value = "job_type" Then ' Checks if cell is equal to criteria 
          Note = Cell.Offset(0, 1).Value ' if does match copies cell one over to the right
                        If Cell.Value = "" Then  ' Checks if blank 
                            Cell.Value = "Na" ' Change blank to NA caues cannot have a blank breaks code 
                            End If ' stops first if  
                            End IF ' stops second if 
          Sheets("Results").Range("D" & lastRowCOlD + 1).Value = Note ' Sets next blank cell in results  to found value 
Next   ' Loops to next cell in Range of Column C we set 


    
    Application.DisplayAlerts = False 'Turns off pop up windows so it wont ask you if are sure you want to delete page 
   Sheets("PullSheet").Delete ' Deletes page ...not needed but I like temp pages and you wanted connection gone 
    Application.DisplayAlerts = True ' Turns back on  




' Below Will remove all Na and replace with blank 


For Each cell In ActiveSheet 
 If cell.Value = "Na" Then Cell.Clear
 Nex




End Sub





For the note in the code : Need to add more Start and End Points for each Tag in your Txt File

Notice how the only things that differ from

Code:
'Now Begins Looping through to move over insert job  


'Start Point 1
  
         
         lastRowCOlA = Sheets("Results").Range("A65536").End(xlUp).Row  ' Gets the next open cell in Colmn A of results page
        If Cell.Value = "insert_job:" Or Cell.Value = "update_job:" Then 'Checks if cell equals criteria if it doesn't skips to next cell
          JobName = Cell.Offset(0, 1).Value ' Sets JobName as the value of the cell one to the right 
             If JobName = "" Then   ' If the cell is blank
                    JobName = "NA"  ' change it from blank to NA IT MUST HAVE A VALUE NOT A BLANK
                End If   ' Stops First IF     
                   End If   ' Stops Second IF  
        Sheets("Results").Range("A" & lastRowCOlA + 1).Value = JobName  ' Puts JobName in next open cell in results  
        
' Ends looking in Job Names From Text File To Results Page 


' End Point 1

And


Code:
' Starts checking if cell is equal to description 


'Start Point 2     
        LastRowColB = Sheets("Results").Range("B65536").End(xlUp).Row ' Find Next empty cell in column b of results 
                   If Cell.Value = "description:" Then 'Checks if cell equals criteria 
              Note = Cell.Offset(0, 1).Value 'Grabs value of cell one to the right
                                If Cell.Value = "" Then ' Checks if cell is blank IT CANNOT BE SO IF IT IS  
                                    Cell.Value = "Na"  ' Change Cell Value to NA to be pasted into results sheet and not mess up code to find next open cell 
                              End If
                                    End IF           
          Sheets("Results").Range("B" & LastRowColB + 1).Value = Note 'Inputs value into results page 
                
' Ends looking for Descrtiption 


'End Point 2


Is that the A and B change in lastRowCol and the Range 's and Your Search Term .



Should be able to just make more of them increasing the letter for each , C D E ect.... and changing your criteria

Easiest is just copy and paste then use cntl + h to replce B with D then change your criteria to appropriate one .
 
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Hi Tyger...

Had an error when I tried to run the macro.

QNtjoL.jpg


edjJhX.jpg
 
Upvote 0
Oh and I can't seem to figure out but I think the macro is running around in a lot of additional loops.

Just 2 jobs which should have resulted in 2 printed rows ended up with 46 rows :ROFLMAO:
 
Upvote 0
Yea there was some mistakes made...:( lol After you gave me all data I was able to make something much better . The code is not very clean and some very random comments but works ...I'm almost positive perfectly. Give it a shot. And how ironic I just finished it now and typing not a minute later after your post.

ONLY change the file path in code :)


https://drive.google.com/file/d/0B5Pn7PG3Fu2HeFRtQUZaZlJmTHc/edit?usp=sharing
 
Last edited:
Upvote 0
Final Code For Thread

Code:
Sub CopyTextFile()


Dim I As Integer




Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


Worksheets.Add().Name = "PullSheet" 'Make the sheet for the data from txt file to go into




    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Tyger\Desktop\test2.txt", Destination:=Range("$A$1"))
        'Change Connection to your file location and Desitnation to where you want to paste
        .Name = "test2"  'Name of connection
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


For Each Cell In Range("B1:B6000")
If Cell.Value = "" Then
Cell.Value = "na"
End If
Next


For Each Cell In Range("C1:C6000")
If Cell.Value = "" Then
Cell.Value = "na"
End If
Next


    
lastRowCOlA = Sheets("PullSheet").Range("A65536").End(xlUp).Row 'Finds he number of the last cell in Column A in Pullsheet


I = 2
For Each Cell In Sheets("PullSheet").Range("A1", Range("A1").Offset(lastRowCOlA, 0))  'Sets to look in each cell in range of data in column A


Debug.Print Cell
'Start Point 1


         lastRowCOlA = wsResults.Range("A65536").End(xlUp).Row  




        If Cell.Value = "insert_job:" Or Cell.Value = "update_job:" Then 'Checks if cell equals criteria if it doesn't skips to next cell
          JobName = Cell.Offset(0, 1).Value ' Sets JobName as the value of the cell one to the right
                     wsResults.Range("A" & lastRowCOlA + 1).Value = JobName  ' Puts JobName in next open cell in results


                   End If   ' Stops Second IF
        




'Start Point 2
        LastRowColB = wsResults.Range("B65536").End(xlUp).Row ' Find Next empty cell in column b of results
                   If Cell.Value = wsOptions.Range("A" & I).Value Then 'Checks if cell equals criteria
              Note = Cell.Offset(0, 1).Value 'Grabs value of cell one to the right
                                          wsResults.Range("B" & LastRowColB + 1).Value = Note 'Inputs value into results page


                                    End If
                




I = I + 1


LastRowColC = wsResults.Range("C65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("C" & LastRowColC + 1).Value = Note
                End If




I = I + 1


LastRowColD = wsResults.Range("D65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("D" & LastRowColD + 1).Value = Note
                End If


I = I + 1
LastRowColE = wsResults.Range("E65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("E" & LastRowColE + 1).Value = Note
                End If
                
I = I + 1


LastRowColF = wsResults.Range("F65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("F" & LastRowColF + 1).Value = Note
                End If
                
                
I = I + 1


LastRowColG = wsResults.Range("G65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("G" & LastRowColG + 1).Value = Note
                End If
I = I + 1


LastRowColH = wsResults.Range("H65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("H" & LastRowColH + 1).Value = Note
                End If
                
I = I + 1


LastRowColI = wsResults.Range("I65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("I" & LastRowColI + 1).Value = Note
                End If
                
I = I + 1


LastRowColJ = wsResults.Range("J65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("J" & LastRowColJ + 1).Value = Note
                End If
                
I = I + 1


LastRowColK = wsResults.Range("K65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("K" & LastRowColK + 1).Value = Note
                End If
I = I + 1


LastRowColL = wsResults.Range("L65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("L" & LastRowColL + 1).Value = Note
                End If
I = I + 1


LastRowColM = wsResults.Range("M65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("M" & LastRowColM + 1).Value = Note
                End If
                
I = I + 1


LastRowColN = wsResults.Range("N65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("N" & LastRowColN + 1).Value = Note
                End If
                
                
                
I = I + 1


LastRowColO = wsResults.Range("O65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("O" & LastRowColO + 1).Value = Note
                End If
                
I = I + 1


LastRowColP = wsResults.Range("P65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("P" & LastRowColP + 1).Value = Note
                End If
I = I + 1


LastRowColQ = wsResults.Range("Q65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("Q" & LastRowColQ + 1).Value = Note
                End If




I = I + 1


LastRowColR = wsResults.Range("R65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("R" & LastRowColR + 1).Value = Note
                End If


I = I + 1


LastRowColS = wsResults.Range("S65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("S" & LastRowColS + 1).Value = Note
                End If
I = I + 1


LastRowColT = wsResults.Range("T65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("T" & LastRowColT + 1).Value = Note
                End If
I = I + 1


LastRowColU = wsResults.Range("U65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("U" & LastRowColU + 1).Value = Note
                End If
I = I + 1


LastRowColV = wsResults.Range("V65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("V" & LastRowColV + 1).Value = Note
                End If




I = I + 1


LastRowColV = wsResults.Range("V65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("V" & LastRowColV + 1).Value = Note
                End If


I = I + 1


LastRowColW = wsResults.Range("W65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("W" & LastRowColW + 1).Value = Note
                End If


I = I + 1


LastRowColX = wsResults.Range("X65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("X" & LastRowColX + 1).Value = Note
                End If
I = I + 1


LastRowColY = wsResults.Range("Y65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("Y" & LastRowColY + 1).Value = Note
                End If


I = I + 1


LastRowColZ = wsResults.Range("Z65536").End(xlUp).Row
                   If Cell.Value = wsOptions.Range("A" & I).Value Then
              Note = Cell.Offset(0, 1).Value
                   wsResults.Range("Z" & LastRowColZ + 1).Value = Note
                End If


I = 2


Next ' Loops Back to check Next Cell in Column A








' Since Jobtype is under a different column than all the other data need new for ecah statement








LastRowColC = Sheets("PullSheet").Range("C65536").End(xlUp).Row ' Finds last cell in column c of pull sheet




For Each Cell In Sheets("PullSheet").Range("C1", Range("C1").Offset(LastRowColC, 0)) 'Sets loop for all items in Colmn C
    LastRowColD = wsResults.Range("D65536").End(xlUp).Row ' Sets next Blank row in Results sheet
      If Cell.Value = "job_type" Then ' Checks if cell is equal to criteria
          Note = Cell.Offset(0, 1).Value ' if does match copies cell one over to the right
                                  wsResults.Range("D" & LastRowColD + 1).Value = Note ' Sets next blank cell in results  to found value


                            End If ' stops second if
Next   ' Loops to next cell in Range of Column C we set




    
    Application.DisplayAlerts = False 'Turns off pop up windows so it wont ask you if are sure you want to delete page
   Sheets("PullSheet").Delete ' Deletes page ...not needed but I like temp pages and you wanted connection gone
    Application.DisplayAlerts = True ' Turns back on




For Each Cell In wsResults.Range("A1:Z6000")
 If Cell.Value = "na" Then Cell.Clear
 Next




wsResults.Activate


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True




End Sub
 
Upvote 0
By the way when I said the code wasn't clean. I mean i didn't indent everything all pretty and may have left some comments that don't apply anymore.


Yea there was some mistakes made...:( lol After you gave me all data I was able to make something much better . The code is not very clean and some very random comments but works ...I'm almost positive perfectly. Give it a shot. And how ironic I just finished it now and typing not a minute later after your post.




https://drive.google.com/file/d/0B5Pn7PG3Fu2HeFRtQUZaZlJmTHc/edit?usp=sharing


And I encourage you to go learn more . these videos taught me tons



https://www.youtube.com/watch?v=KHO5NIcZAc4&list=PLNIs-AWhQzckr8Dgmgb3akx_gFMnpxTN5
 
Upvote 0
Just found a minor problem:

For start_times:

It seems like the entries are filling up on each other. Meaning that even though job 1 doesn't have the start_time, the start_time from eg job 10 is recorded in the first row.

I think the rest are affected as well... meaning that if a tag doesn't appear in one job, if the tag appears for the next job, it writes into the first job's row instead
 
Upvote 0
Hi,
. I followed this thread with interest as a beginner I learn a lot by trying to follow and understand as much as I can. Yesterday I answered 2 similar but much simpler VBA Text to Excel Threads.
. A couple of very minor contributions from me to this Thread


Amazing video set :

Excel VBA Introduction: Excel VBA Introduction - YouTube

If you got free time I'd suggest watching them all.



. 1 – That video and a lot more of the same are given in Post #5 and #6 of this MrExcel Thread
http://www.mrexcel.com/forum/genera...s/780271-excel-visual-basic-applications.html
. I downloaded them all and have a lifetime of nighttime videos to fall asleep to! Second to participating and practicing in this forum, I find them the best way to learn.
.. 2 – yesterday a VBA command line of this form frequently got me out of lots of strange annoying problems

Code:
Cells(Rw, Cm).NumberFormat = "@"

.-helps to offset Excel’s habit of making unpredictable format changes when dealing with Text to Excel problems.
 
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top