VBA macro stops unexpectedly after writing to a cell in active sheet

[JKMS]

I am a novice and adapted some code found in the forum to read a text file, find specific data in that file, and write it to an Excel sheet.

It works properly to find the data, but the macro stops unexpectedly, immediately after changing a cell in the active sheet.

I know that the code successfully identifies the data I want, because if I Debug.Print the result to the Immediate window instead of writing to the active sheet, all the results are there.

But any version of code I write that changes any cell in the active sheet causes the macro to immediately stop.

What am I doing wrong?

Grateful for any help I can get!

Private Sub CommandButton1_Click()

    Const FindText = "Total sludge adsorption:    "
    Dim fData As String, fPath As String, TextLine As String, FileNum As Integer, Rw As Integer
    
    fPath = GetPath
    If fPath = "" Then GoTo TheEnd

    Rw = 1
    'Cells(Rw, "A").Resize(, 1) = Array("SludgePercent") 'Labels the column before adding data - if this line of code is enabled, the macro stops here and only the column name is written

    FileNum = FreeFile()
    Open fPath For Input As #FileNum
       
        While Not EOF(FileNum)
            Line Input #FileNum, TextLine
            TextLine = Trim(TextLine)
                        
            If Left(TextLine, 28) = FindText Then  'Looks for the data label preceding the data I want
                Debug.Print Replace(Replace(TextLine, FindText, ""), "  percent", "")  'This prints all the data successfully to the Immediate window
                Rw = Rw + 1
                'Cells(Rw, 1) = Replace(Replace(fData, FindText, ""), "  percent", "")  'This should write the results to the active sheet - If this line of code is enabled, the macro stops here and only one result is written
            End If
            
         Wend
    
    Close #FileNum

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

 

[mohadin]

Hi
If

Debug.Print Replace(Replace(TextLine, FindText, ""), "  percent", "")

is ok
then
should be

 Cells(Rw, 1) = Replace(Replace(TextLine, FindText, ""), "  percent", "")

 

[JKMS]

Thanks for your response, mohadin

(Fixed the variable name that you caught... TextLine replaced fData... thanks)

Here is the result when I run the code as shown above, so I know the algorithm works:

When I uncomment the following line of code:

Cells(Rw, 1) = Replace(Replace(TextLine, FindText, ""), "  percent", "")

This is what I see in my Excel sheet:

And this is what I see in the Immediate window:

So you can see that the macro just stops after finding the first result and writing it to the sheet.

If I uncomment the following line of code:

Cells(Rw, "A").Resize(, 1) = Array("SludgePercent")

Then this is what I see in my Excel sheet:

So you can see that the macro stops immediately after writing anything to the sheet.

 

[JKMS]

I was thinking that as a temporary fix to just get this done, I could save the results in an array and write the whole array at once into a range in Excel, since I can edit Excel one time. I am trying to figure that out... I haven't yet.

But that's not really an acceptable fix in the long run, because I expect to have cases where I will need to change more than just one array of data.

It seems like I must have some sort of setting messed up, because I tested simpler code that others use successfully and I get the same problem.

 

[mohadin]

Try

 If Left(TextLine, 28) = FindText Then  'Looks for the data label preceding the data I want
        Debug.Print Replace(Replace(TextLine, FindText, ""), "  percent", "")  'This prints all the data successfully to the Immediate window

        ActiveSheet.Cells(Rw, 1) = Replace(Replace(TextLine, FindText, ""), "  percent", "")  'This should write the results to the active sheet - If this line of code is enabled, the macro stops here and only one result is written
        Rw = Rw + 1
    End If

 

[JKMS]

Hi mohadin - thanks for this reply. I will try your fix now, but wanted to check in to say that I just tested my original code on my old computer and it works fine.

I have been using a brand new computer with a new install of Excel 365... it does not work here.

It did word in Windows 8, Excel 2016. Hmmm...

I will try your code now.

 

[JKMS]

Try

 If Left(TextLine, 28) = FindText Then  'Looks for the data label preceding the data I want
        Debug.Print Replace(Replace(TextLine, FindText, ""), "  percent", "")  'This prints all the data successfully to the Immediate window

        ActiveSheet.Cells(Rw, 1) = Replace(Replace(TextLine, FindText, ""), "  percent", "")  'This should write the results to the active sheet - If this line of code is enabled, the macro stops here and only one result is written
        Rw = Rw + 1
    End If

The same thing happened - your version successfully wrote the first result to the sheet, and then the macro stopped.

Both my original code and your fix work fine on my old computer. No problems.

This is weird. I will reboot...

 

[JKMS]

The reboot cured it. Crazy.

I wasted so much time on this, thinking I was making a coding mistake but actually Excel was just in some weird state and needed rebooting. SMH

thanks, mohadin for spending time to help

 

[mohadin]

No Problems at all
Thank you
BE happy & safe