CODEWITHSUNDEEP
arraysexcelvba
todayspresent
todayspresent

Reputation: 123

Excel VBA Extract Specified Start & Length from Txt file

I have a code for Excel 2007 that runs without failing.

  1. But it is extremely & unusually slow - making my computer unresponsive for the 1-2 minutes it runs.
  2. 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

Upvotes: 1

Views: 391

Answers (2)

brettdj
brettdj

Reputation: 55682

I updated your code to use an array rather than cell by cell wrote and it ran instantly

Optimisations made

  1. Avoid cell range loops, especially writing cell by cell. Use arrays instead. This is the big one
  2. Resize(1,1) does nothing as it keeps the cell as a single cell
  3. Long is more efficient than Integer
  4. Use the string functions Mid$ rather than their slower variant alternatives Mid
  5. The allread variable was an un-necessary intermediate step
  6. 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

Upvotes: 3

Fls'Zen
Fls'Zen

Reputation: 4664

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.

Upvotes: 0

Related Questions