I have a function within an Excel spreadsheet that pulls data from a fixed width txt file and pastes it into a spreadsheet. The function currently stores each set of data into an array and pastes it in row by row. However, I am getting go a point where the txt file has 90,000 rows in it and the processing time has increased for the macro. I was trying to optimize the macro so that instead of going row by row, it stores all the data into an array and pastes it in all at once to reduce the amount of times the macro calls to the worksheet. Here is the original code:

Function ImportFixedWidth(FileName As String, _
        StartCell As Range, _
        IgnoreBlankLines As Boolean, _
        SkipLinesBeginningWith As String, _
                SkipLinesBeginningWith2 As String, _
        ByVal FieldSpecs As String) As Long

    Dim FINdx As Long
    Dim c As Long
    Dim r As Range
    Dim FNum As Integer
    Dim s As String
    Dim RecCount As Long
    Dim FieldInfos() As String
    Dim FInfo() As String
    Dim N As Long
    Dim T As String
    Dim B As Boolean
    Dim InfoParts As Variant
    Dim rowData As Variant

    Application.EnableCancelKey = xlInterrupt
    On Error GoTo EndOfFunction:

    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found
        ImportFixedWidth = -1
        Exit Function
    End If
    
    If Len(FieldSpecs) < 3 Then
        ' invalid FieldSpecs
        ImportFixedWidth = -1
        Exit Function
    End If
        
    If StartCell Is Nothing Then
        ImportFixedWidth = -1
        Exit Function
    End If
       
    Set r = StartCell(1, 1)
    c = r.Column
    FNum = FreeFile
  
    FieldInfos = Split(FieldSpecs, "|")
    
    Open FileName For Input Access Read As #FNum

    If StrComp(Right(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then
        FieldSpecs = Left(FieldSpecs, Len(FieldSpecs) - 1)
    End If
    
    Do
        ' read the file
        Line Input #FNum, s
        If (SkipLinesBeginningWith <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith)), SkipLinesBeginningWith, vbTextCompare) And SkipLinesBeginningWith2 <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith2)), SkipLinesBeginningWith2, vbTextCompare)) Then
            If Len(s) = 0 Then
                If IgnoreBlankLines = False Then
                    Set r = r(2, 1)
                Else
                    ' do nothing
                End If
            Else
              
    
                If FieldSpecs = vbNullString Then
                  
                Else
                
                    If ImportThisLine(s) = True Then
                        FINdx = LBound(FieldInfos)
                        ReDim rowData(1 To UBound(FieldInfos) + 1)
                        c = r.Column
                    
                  Do While FINdx <= UBound(FieldInfos)
                InfoParts = Split(FieldInfos(FINdx), ",")
            rowData(FINdx - LBound(FieldInfos) + 1) = Mid(s, CLng(InfoParts(0)), CLng(InfoParts(1)))
              
        FINdx = FINdx + 1
    Loop
    r.Offset(RecCount, 0).Resize(1, UBound(rowData)).Value = rowData
      

                    End If
                    Set r = r(2, 1)
                End If
            End If
        Else
            ' no skip first char
        End If
        
    Loop Until EOF(FNum)
    
EndOfFunction:
    If Err.Number = 0 Then
        ImportFixedWidth = RecCount
    Else
        ImportFixedWidth = -1
    End If
    Close #FNum
    
End Function

I tried to update the code to the following to attempt to optimize the performance:

Function ImportFixedWidth(FileName As String, _
                          StartCell As Range, _
                          IgnoreBlankLines As Boolean, _
                          SkipLinesBeginningWith As String, _
                          SkipLinesBeginningWith2 As String, _
                          ByVal FieldSpecs As String) As Long
    Dim FINdx As Long
    Dim c As Long
    Dim r As Range
    Dim FNum As Integer
    Dim s As String
    Dim RecCount As Long
    Dim FieldInfos() As String
    Dim InfoParts As Variant
    Dim rowData As Variant
    Dim allData() As Variant
    Dim numRows As Long
    
    Application.EnableCancelKey = xlInterrupt
    On Error GoTo EndOfFunction:
    
    If Dir(FileName, vbNormal) = vbNullString Then
        ' file not found
        ImportFixedWidth = -1
        Exit Function
    End If
    
    If Len(FieldSpecs) < 3 Then
        ' invalid FieldSpecs
        ImportFixedWidth = -1
        Exit Function
    End If
    
    If StartCell Is Nothing Then
        ImportFixedWidth = -1
        Exit Function
    End If
    
    Set r = StartCell(1, 1)
    c = r.Column
    FNum = FreeFile
    
    FieldInfos = Split(FieldSpecs, "|")
    
    Open FileName For Input Access Read As #FNum
    
    If StrComp(Right(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then
        FieldSpecs = Left(FieldSpecs, Len(FieldSpecs) - 1)
    End If
    
    Do
        ' read the file
        Line Input #FNum, s
        If (SkipLinesBeginningWith <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith)), SkipLinesBeginningWith, vbTextCompare)) And (SkipLinesBeginningWith2 <> vbNullString And StrComp(Left(Trim(s), Len(SkipLinesBeginningWith2)), SkipLinesBeginningWith2, vbTextCompare)) Then
            If Len(s) = 0 Then
                If IgnoreBlankLines = False Then
                    Set r = r(2, 1)
                Else
                    ' do nothing
                End If
            Else
                If FieldSpecs = vbNullString Then
                Else
                    If ImportThisLine(s) = True Then
                        FINdx = LBound(FieldInfos)
                        ReDim rowData(1 To UBound(FieldInfos) + 1)
                        c = r.Column
                        
                        Do While FINdx <= UBound(FieldInfos)
                            InfoParts = Split(FieldInfos(FINdx), ",")
                            rowData(FINdx - LBound(FieldInfos) + 1) = Mid(s, CLng(InfoParts(0)), CLng(InfoParts(1)))
                            FINdx = FINdx + 1
                        Loop
                        RecCount = RecCount + 1
                        ReDim Preserve allData(1 To RecCount)
                        allData(RecCount) = rowData
                    End If
                    Set r = r(2, 1)
                End If
            End If
        Else
            ' no skip first char
        End If
    Loop Until EOF(FNum)
    
    If RecCount > 0 Then
        numRows = UBound(allData, 1)
        StartCell.Resize(numRows, UBound(allData, 2)).Value = allData
    End If
    
EndOfFunction:
    If Err.Number = 0 Then
        ImportFixedWidth = RecCount
    Else
        ImportFixedWidth = -1
    End If
    Close #FNum
End Function

HoweverI am consistently getting a “Subscript out of Range” error on the following line of code:

    If RecCount > 0 Then
        numRows = UBound(allData, 1)
        StartCell.Resize(numRows, UBound(allData, 2)).Value = allData
    End If

I put a watch on the code and the array is populating as expected with the data from the txt file. I’m sure there’s an easy solution, but is there something that I am missing that would solve the “Subscript out of Range” error? Thank you very much for the help!