Excel VBA Extract Specified Start & Length from Txt file - arrays

Question

I have a code for Excel 2007 that runs without failing.
But it is extremely & unusually slow - making my computer unresponsive for the 1-2 minutes it runs.
The files are about 14,000 kb's - so not too large.
If possible I'd like someone to tell me what I could do to make it run without causing my computer to hang. Thanks in advance.
Sub ReadFileIntoExcel()
Dim fPath As String
Const fsoForReading = 1
Dim readlength As Integer
Dim readstart As Integer
readlength = Worksheets("READFILE").Cells(1, "E").Value
readstart = Worksheets("READFILE").Cells(1, "D").Value
fPath = Worksheets("READFILE").Cells(1, "C").Value
Dim objFSO As Object
Dim objTextStream As Object, txt, allread, rw
Set objFSO = CreateObject("scripting.filesystemobject")
If objFSO.FileExists(fPath) Then
Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading)
rw = 1
Do Until objTextStream.AtEndOfStream
txt = objTextStream.ReadLine
allread = Trim(Mid(txt, readstart, readlength))
With ActiveWorkbook.Sheets("READFILE").Cells(rw, 7).Resize(1, 1)
.NumberFormat = "#" 'format cells as text
.Value = Array(allread)
End With
rw = rw + 1
Loop
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
Exit Sub

Answer 1

I updated your code to use an array rather than cell by cell wrote and it ran instantly
Optimisations made
Avoid cell range loops, especially writing cell by cell. Use arrays instead. This is the big one
Resize(1,1) does nothing as it keeps the cell as a single cell
Long is more efficient than Integer
Use the string functions Mid$ rather than their slower variant alternatives Mid
The allread variable was an un-necessary intermediate step
Using variable names for objects (ie ws for the worksheet), prevents longer references
code
Sub ReadFileIntoExcel()
Dim fPath As String
Dim ws As Worksheet
Const fsoForReading = 1
Dim readlength As Long
Dim readstart As Long
Dim rw as Long
Dim X()
Set ws = Worksheets("READFILE")
readlength = ws.Cells(1, "E").Value
readstart = ws.Cells(1, "D").Value
fPath = ws.Cells(1, "C").Value
Dim objFSO As Object
Dim objTextStream As Object
Set objFSO = CreateObject("scripting.filesystemobject")
If objFSO.FileExists(fPath) Then
Set objTextStream = objFSO.OpenTextFile(fPath, fsoForReading)
rw = 1
ReDim X(1 To 1, 1 To 1000)
Do Until objTextStream.AtEndOfStream
txt = objTextStream.ReadLine
If rw Mod 1000 = 0 Then ReDim Preserve X(1 To 1, 1 To UBound(X, 2) + 1000)
X(1, rw) = Trim$(Mid$(txt, readstart, readlength))
rw = rw + 1
Loop
ws.[G1].Resize(UBound(X, 2), 1) = Application.Transpose(X)
ws.Columns("G").NumberFormat = "#"
objTextStream.Close
Set objTextStream = Nothing
Set objFSO = Nothing
Exit Sub
End If
End Sub

Answer 2

You might try turning off screen updating while the cells are being updated. If you are touching a great many cells, this will definitely speed things up.
Application.ScreenUpdating = False
...update cells...
Application.ScreenUpdating = True
There are other things you can do as well, such as turning off calculations, but it doesn't sound like you have formulas trying to evaluate the cells your setting.