Random Slow Down Of Text Import

Option Explicit
Option Compare Text
Dim Rw As Long, Cl As Long, SheetNumber As Long, InputCounter As Long, LastRowForInput As Long, MaxRowsPerSheet As Long, RowsThisSheet As Long, TruncatedCount As Long                  ' Current Column
Dim FName As Variant
Dim FNum As Integer
Dim WS As Worksheet
Dim InputLine As String, SplitChar As String
Dim Arr As Variant
Dim stdte As Date
Sub ImportZResProd()
' data starts on this row on the first sheet
Const C_START_ROW_FIRST_PAGE = 1
' data starts on this row for all subsequent sheets
Const C_START_ROW_LATER_PAGES = 1
' worksheet name where data should start. This sheet must exist.
Const C_START_SHEET_NAME = "ZResProd"
' what column do we start placing the data
Const C_START_COLUMN = 1
' newly created worksheets will be named  C_SHEET_NAME_PREFIX  & Format(SheetNum,"0")
Const C_SHEET_NAME_PREFIX = "ZResProd"
' newly created worksheets will be based on this template sheet. set to vbNullString if
' you don't want to use a template sheet and use a blank sheet instead.
Const C_TEMPLATE_SHEET_NAME = vbNullString
' update the Application.StatusBar every C_UPDATE_STATUSBAR_EVERY_N_RECORDS  records.
' set this to 0 if you don't want status bar messages.
Const C_UPDATE_STATUSBAR_EVERY_N_RECORDS = 1000
' this is the message to be displayed in the status bar. The number of records
' read so far will be appended to this value.
Const C_STATUSBAR_TEXT = "Processing ZResProd.txt Record: "
SheetNumber = 1
stdte = Now()
If Application.ActiveWorkbook Is Nothing Then
    SwitchOn
    MsgBox "There is no active workbook."
    Exit Sub
End If
 
SplitChar = ""
MaxRowsPerSheet = 0&
LastRowForInput = ActiveWorkbook.Worksheets(1).Rows.Count
On Error Resume Next
Err.Clear
Set WS = ActiveWorkbook.Worksheets("ZResProd")
If Err.Number <> 0 Then
    ThisWorkbook.Sheets.Add.Name = "ZResProd"
End If
ThisWorkbook.Sheets("ZResProd").PageBreak = False
ThisWorkbook.Sheets("ZResProd").Cells.ClearFormats
ThisWorkbook.Sheets("ZResProd").Cells.Clear
ThisWorkbook.Sheets("ZResProd").Cells.Delete


If WS.ProtectContents = True Then
    SwitchOn
    MsgBox "The worksheet '" & WS.Name & "' is protected."
    Exit Sub
End If
If C_TEMPLATE_SHEET_NAME <> vbNullString Then
    If ActiveWorkbook.Worksheets(C_TEMPLATE_SHEET_NAME).ProtectContents = True Then
        SwitchOn
        MsgBox "The Template Sheet (" & C_TEMPLATE_SHEET_NAME & ") is protected."
        Exit Sub
    End If
End If
If ActiveWorkbook.ProtectStructure = True Then
    SwitchOn
    MsgBox "The ActiveWorkbook is protected."
    Exit Sub
End If
 
''''''''''''''''''''''''''''''''''''''''''''''
' Prompt the user for a TXT or CSV file
''''''''''''''''''''''''''''''''''''''''''''''
'FName = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt," & _
                                                "CSV Files (*.csv),*.csv")
FName = "S:\IS Function\13. Data Transfer\EAC Report\ERP0000021429 - Zresprod.TXT"
'FName = "C:\EAC Report\ERP0000021429 - Zresprod.TXT"
If FName = False Then
    ' user clicked CANCEL. get out now.
    Exit Sub
End If


'''''''''''''''''''''''''''''''''''''''''''''
' See if the file FName is open by another
' process. If it is, exit the procedure.
'''''''''''''''''''''''''''''''''''''''''''''
If CheckFileIsOpen(CVar(FName)) = True Then
    MsgBox "The file '" & FName & "' is open by another process."
    SwitchOn
    Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''
' Get a file number and open the file
On Error Resume Next
FNum = FreeFile
Err.Clear
Open FName For Input Access Read As #FNum
If Err.Number <> 0 Then
    MsgBox "An error occurred opening file '" & FName & "'." & vbCrLf & _
        "Error Number: " & CStr(Err.Number) & vbCrLf & _
        "Description:  " & Err.Description
    Close #FNum
    SwitchOn
    Exit Sub
End If
On Error GoTo 0
Rw = C_START_ROW_FIRST_PAGE


''''''''''''''''''''''''''''''''''''''''''''''
' If LastRowForInput is <= 0, then set it
' to Rows.Count
''''''''''''''''''''''''''''''''''''''''''''''
If LastRowForInput <= 0 Then
    LastRowForInput = WS.Rows.Count
End If
''''''''''''''''''''''''''''''''''''''''
' If MaxRowsPerSheet is <= 0, use Rows.Count
''''''''''''''''''''''''''''''''''''''''
If MaxRowsPerSheet <= 0 Then
    MaxRowsPerSheet = Rows.Count
End If
InputCounter = 1
RowsThisSheet = 1
''''''''''''''''''''''''''''''''''''''''''''''
' Loop until we hit the end of the file.
''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo 0
Do Until EOF(FNum)
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Get the next line of data from the file
    ''''''''''''''''''''''''''''''''''''''''''''''
    Line Input #FNum, InputLine
    ''''''''''''''''''''''''''''''''''''''''''
    ' Increment counters.
    ''''''''''''''''''''''''''''''''''''''''''
    InputCounter = InputCounter + 1
    'RowsThisSheet = RowsThisSheet + 1
    RowsThisSheet = Rw + 1
    
    ''''''''''''''''''''''''''''''''''''''''''
    ' Determine whether to update the StatusBar.
    ''''''''''''''''''''''''''''''''''''''''''
    If C_UPDATE_STATUSBAR_EVERY_N_RECORDS > 0 Then
        If InputCounter Mod C_UPDATE_STATUSBAR_EVERY_N_RECORDS = 0 Then
        frmPBUUpdate.LblStatus = C_STATUSBAR_TEXT & Format(InputCounter, "#,##0")
        frmPBUUpdate.Repaint
        DoEvents
        frmPBUUpdate.Show vbModeless
        End If
    End If
   
   If Left(InputLine, 5) <> "|----" And Left(InputLine, 5) <> "-----" And Len(InputLine) <> 0 And InStr(1, InputLine, "Sunseeker Planned Demand by Boat", 0) = 0 And InputLine <> WS.Cells(1, 1) Then
    WS.Cells(Rw, C_START_COLUMN).Value = InputLine
    Rw = Rw + 1
    End If
    
    If (Rw > Rows.Count) Or (Rw > LastRowForInput) Or (RowsThisSheet > MaxRowsPerSheet) Then
        SheetNumber = SheetNumber + 1
        If C_TEMPLATE_SHEET_NAME = vbNullString Then
            Set WS = ActiveWorkbook.Worksheets.Add(after:=WS)
        Else
            ActiveWorkbook.Worksheets(C_TEMPLATE_SHEET_NAME).Copy after:=WS
            Set WS = ActiveWorkbook.ActiveSheet
        End If
        On Error Resume Next
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' ignore the error that might arise if there is already a
        ' sheet named
        '   C_SHEET_NAME_PREFIX & Format(SheetNumber, "0")
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        WS.Name = C_SHEET_NAME_PREFIX & Format(SheetNumber, "0")
        On Error GoTo 0
        
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' Reset out counters.
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Rw = C_START_ROW_LATER_PAGES
        RowsThisSheet = 0
    End If
Loop
Set WS = Nothing
Close FNum
 
 frmPBUUpdate.LblStatus = C_STATUSBAR_TEXT & Format(InputCounter, "#,##0") & "- Parsing Text To Columns"
        frmPBUUpdate.Repaint
        DoEvents
        frmPBUUpdate.Show vbModeless
ThisWorkbook.Sheets("ZresProd").Activate
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        
Columns(1).Delete
End Sub