Search text file for specific data and populate Excel column

[JKMS]

My question is similar to a previous thread:

Search and copy data from text to Excel

Hi team, I have one text file which contains data about list of errors. I want to search only for ERROR word which have occurred multiple times in file and copy data quoted in '......' which is following the word ERROR= Format is: ERROR = "short name of error.(number of words may vary,but the...

www.mrexcel.com

which seemed to have a working solution, but that solution is not working for me.

I run predictive models for large batches of chemicals and these output a long text file. I want to find a few specific values within that file and write them into columns in Excel.

I adapted the code suggested in the thread above for my case, but the DO loop stops as soon as the IF statement finds the first instance of the data I want and writes it into Excel. So I can get one value correctly into my spreadsheet but no further values.

I am currently using this code (but tried other syntax around the DO loop and get the same result):

Private Sub CommandButton1_Click()

Const FindText = "Total sludge adsorption: " 'the label that occurs just before the data I want to grab
Dim fData As String, fPath As String, cel As Range

fPath = GetPath
If fPath = "" Then GoTo TheEnd

Set cel = Range("A3")

Open fPath For Input As #1

Do
Line Input #1, fData
fData = Trim(fData)

If Left(fData, 28) = FindText Then
cel = Replace(Replace(fData, FindText, ""), " percent", "") 'the first time this line of code runs, the macro stops. Why?
'if I put some debugging code here it will not run after IF statement is true and first instance of my desired data is written to spreadsheet
'if I comment out the entire "IF... End If" section, the DO loop successfully reads every line from my text file
Set cel = cel.Offset(1)
End If

Loop Until EOF(1)

Close #1

Exit Sub

TheEnd:
MsgBox "file not selected", , ""
End Sub

Private Function GetPath() As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Text", "*.txt"
.Show
If .SelectedItems.count = 1 Then GetPath = .SelectedItems.Item(1)
End With
End Function


A test version of my text file looks like this:

Removal In Wastewater Treatment (recommended maximum 95%):
Total removal: 99.99 percent
Total biodegradation: 78.15 percent
Total sludge adsorption: 21.84 percent
Total to Air: 0.00 percent
(using Biowin/EPA draft method)

Level III Fugacity Model:
Mass Amount Half-Life Emissions
(percent) (hr) (kg/hr)
Air 0.878 11.4 1000
Water 23.4 360 1000
Soil 74.9 720 1000
Sediment 0.867 3.24e+003 0
Persistence Time: 493 hr

Removal In Wastewater Treatment (recommended maximum 95%):
Total removal: 99.99 percent
Total biodegradation: 78.15 percent
Total sludge adsorption: 1.99 percent
Total to Air: 0.00 percent
(using Biowin/EPA draft method)


I am a novice here... it seems I must be missing something really basic (no pun intended). I am grateful for any help anyone is willing to provide!

 

[JKMS]

Sorry - I think I needed to do this for formatting?

Private Sub CommandButton1_Click()

   Const FindText = "Total sludge adsorption:    " 'the label that occurs just before the data I want to grab
   Dim fData As String, fPath As String, cel As Range
   
   fPath = GetPath
   If fPath = "" Then GoTo TheEnd

   Set cel = Range("A3")

   Open fPath For Input As #1
   
       Do
           Line Input #1, fData
           fData = Trim(fData)

           If Left(fData, 28) = FindText Then
               cel = Replace(Replace(fData, FindText, ""), "  percent", "") 'the first time this line of code runs, the macro stops. Why?
               'if I put some debugging code here it will not run after IF statement is true and first instance of my desired data is written to spreadsheet
               'if I comment out the entire "IF... End If" section, the DO loop successfully reads every line from my text file
               Set cel = cel.Offset(1) 
           End If
      
       Loop Until EOF(1)
   
   Close #1

Exit Sub

TheEnd:
MsgBox "file not selected", , ""
End Sub

Private Function GetPath() As String
With Application.FileDialog(msoFileDialogFilePicker)
   .AllowMultiSelect = False
   .Filters.Add "Text", "*.txt"
   .Show
   If .SelectedItems.count = 1 Then GetPath = .SelectedItems.Item(1)
End With
End Function

 

[JKMS]

I have been trying other ways to accomplish this task, and I find that all versionf stop immediately after the first time writing data to a cell in the active worksheet

If I Debug.Print the result to the Immediate window instead of the active worksheet, the code is working as it should*

*when I did this I realized I used the variable name fPath instead of TextLine in a few spots incorrectly above and fixed that. Once I fixed that I realize the problem is not the code but some weirdness when I edit the active sheet.

I am going to mark this as solved, because the thread title no longer reflects the problem I am having. I will start a new thread that is specific to this problem.