Search text file for specific data and populate Excel column

JKMS

New Member
Joined
Mar 27, 2021
Messages
9
Office Version
  1. 365
My question is similar to a previous thread:


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!
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

JKMS

New Member
Joined
Mar 27, 2021
Messages
9
Office Version
  1. 365
Sorry - I think I needed to do this for formatting?

VBA Code:
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

New Member
Joined
Mar 27, 2021
Messages
9
Office Version
  1. 365
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,010
Messages
5,639,541
Members
417,097
Latest member
miguel_z

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
Top