Stop intensive file process? - vba

Question

I'm using the following function to read files into a spreadsheet. I was thinking of adding a stop button (something like this) but the problem is that while this is running it completely locks up Excel and I cannot interact with it in any way. Is there a way to gracefully stop something like this? Note that these are huge files (500,000+ lines)
Function LoadFile(m)
Dim WrdArray() As String
Dim txtstrm As TextStream
Dim line As String
Dim clm As Long
Dim Rw As Long
Dim Dash As Worksheet
Set Dash = Sheets("Dashboard")
Set cellStatus = Dash.Range("E3")
Set txtstrm = FSO.OpenTextFile("s:\views_" & m & ".txt")
Rw = 1
Do Until txtstrm.AtEndOfStream
If Rw Mod 4 = 0 Then cellStatus.Value = "Loading " & m & "... /"
If Rw Mod 4 = 1 Then cellStatus.Value = "Loading " & m & "... |"
If Rw Mod 4 = 2 Then cellStatus.Value = "Loading " & m & "... \"
If Rw Mod 4 = 3 Then cellStatus.Value = "Loading " & m & "... -"
line = txtstrm.ReadLine
clm = 1
WrdArray() = Split(line, "|!|")
For Each wrd In WrdArray()
Sheets(m).Cells(Rw, clm) = wrd
clm = clm + 1
Next wrd
Rw = Rw + 1
Loop
txtstrm.Close
LoadFile = Rw
End Function

Answer 1

First, turn off screen refreshing and calculation.
Application.ScreenUpdating = False
Application.Calculation = xlManual
then at the very end, turn back on
Application.ScreenUpdating = True
Application.Calculation = XlCalculationAutomatic
Additonally, if you add some type of counter that, after X iterations, prompts the user to continue or not, something like
Dim myCount as Long
...your loop starts here
myCount = myCount + 1
If myCount mod 1000 = 0 then
toContinue = msgBox("Continue with macro?",vbYesNo)
If toContinue = vbNo then exit sub
End if
...continue loop
Edit: Bah, I'll have to tweak that If myCount mod 1000 = 0 to something better...basically an even divisor of 1000 or something.
Also, is the loading "animation" required? I bet that contributes to it taking long when running over that many cells. And, just thought of it, when you turn off screenupdating, you won't see that animation, so maybe comment it out and see how it runs.

Answer 2

In order for excel not to 'lock up' you have to call 'DoEvents'. Using the following will also speed up your process, however it appears as though you'll need screen updating to update the status bar, and EnableEvents to operate your button press event.
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False
You can use the application's status bar at the very bottom if you want by doing the following:
Application.StatusBar = "Your Value Here"
Just make sure to clear it before you leave your function. If you wanted to be really 'safe' you can store its old previous value before writing to it then restore it here.
Application.StatusBar = ""
Your modified code is below:
Function LoadFile(m)
Dim WrdArray() As String
Dim txtstrm As TextStream
Dim line As String
Dim clm As Long
Dim Rw As Long
Dim Dash As Worksheet
Application.Calculation = xlManual
Set Dash = Sheets("Dashboard")
Set cellStatus = Dash.Range("E3")
Set txtstrm = FSO.OpenTextFile("s:\views_" & m & ".txt")
Rw = 1
Do Until txtstrm.AtEndOfStream
If Rw Mod 4 = 0 Then Application.StatusBar = "Loading " & m & "... /"
If Rw Mod 4 = 1 Then Application.StatusBar = "Loading " & m & "... |"
If Rw Mod 4 = 2 Then Application.StatusBar = "Loading " & m & "... \"
If Rw Mod 4 = 3 Then Application.StatusBar = "Loading " & m & "... -"
line = txtstrm.ReadLine
clm = 1
WrdArray() = Split(line, "|!|")
For Each wrd In WrdArray()
Sheets(m).Cells(Rw, clm) = wrd
clm = clm + 1
Next wrd
Rw = Rw + 1
'This will insure that excel doesn't lock up or freeze
DoEvents
Loop
txtstrm.Close
LoadFile = Rw
Application.Calculation = XlCalculationAutomatic
Application.StatusBar = ""
End Function

Answer 3

Not sure why you do this in a Function, but if you have Sub that calls this, it may be better to pause calculation there.
Anyway, try this (dumping array values in one go):
Function LoadFile(m)
Dim WrdArray() As String
Dim txtstrm As Object
Dim line As String
Dim clm As Long ' Now used as number of items in the Split
Dim CalcMode As Long
Dim Rw As Long
Dim Dash As Worksheet
Set Dash = Sheets("Dashboard")
'Set cellStatus = Dash.Range("E3")
Set txtstrm = FSO.OpenTextFile("s:\views_" & m & ".txt")
Rw = 1
CalcMode = Application.Calculation ' Save calculation mode
Application.Calculation = xlCalculationManual ' Change to Manual Calculation
Do Until txtstrm.AtEndOfStream
Application.StatusBar = Now & ": Loading " & m & " (Rw: " & Rw & ")"
'If Rw Mod 4 = 0 Then cellStatus.Value = "Loading " & m & "... /"
'If Rw Mod 4 = 1 Then cellStatus.Value = "Loading " & m & "... |"
'If Rw Mod 4 = 2 Then cellStatus.Value = "Loading " & m & "... \"
'If Rw Mod 4 = 3 Then cellStatus.Value = "Loading " & m & "... -"
line = txtstrm.ReadLine
'clm = 1
WrdArray = Split(line, "|!|")
clm = UBound(WrdArray) + 1 ' Number of items in the split
' Dump the array to cells value to resized range from Col A
Sheets(m).Cells(Rw, "A").Resize(, clm).Value = WrdArray
'For Each wrd In WrdArray()
' Sheets(m).Cells(Rw, clm) = wrd
' clm = clm + 1
'Next wrd
Rw = Rw + 1
Loop
txtstrm.Close
Application.StatusBar = False ' Reset status bar
Application.Calculation = CalcMode ' restore calculation mode
LoadFile = Rw
End Function