Speeding up VBA Code to Run Faster

Question

I have an Excel Workbook where the user imports a text file by the click of a button. My code works exactly as I need it to but it is extremely slow when filling in column H, Reading Date. Here is what my Excel Workbook looks like when the text file has been imported to the excel sheet:

Here is my code:

Sub Import_Textfiles()
Dim fName As String, LastRow As Integer

Worksheets("Data Importation Sheet").Activate

LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    ' Finds the first blank row to import text file data to
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If fName = "False" Then Exit Sub

  With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("A" & LastRow))
        .Name = "2001-02-27 14-48-00"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 2
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(14, 14, 8, 16, 12, 14)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.SmallScroll Down:=0


    Dim strShortName As String


    'Adding Reading Date to Excel Sheet:
    Dim rowCount As Integer, currentRow As Integer
    Dim sourceCol As Integer, nextCol As Integer
    Dim currentRowValue As String
    Dim fileDate1 As String
    Dim fileDate2 As String

    sourceCol = 1 'columnA
    nextCol = 8 'column H
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    strShortName = fName
    fileDate1 = Mid(fName, InStrRev(fName, "\") + 1)
    fileDate2 = Left(fileDate1, 10)

    Cells(LastRow, 9) = ("Updating Location: " & strShortName)

    For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, nextCol).Value
        If currentRowValue = "" Then
        Cells((currentRow), (nextCol)).Select
        Cells((currentRow), (nextCol)) = fileDate2
        End If
    Next

End Sub

If anyone has any suggestions as to how I can speed up the importation of the reading date I would appreciate it greatly! Thanks in advance!

Answer 1

The best solution depends on a few things, that aren't clear to me from provided data. The following change will speed it up a lot (selecting cells takes a lot of time), but its not the optimum. If its still to slow, please provide ~ number of rows and ~% of rows (in column H), that are filled before you get to the following code. Then either searching for missing values or (probably in most cases) copying column H into an array and copying back after updating the values will do the trick.

Old code:

For currentRow = 1 To rowCount
    currentRowValue = Cells(currentRow, nextCol).Value
    If currentRowValue = "" Then
    Cells((currentRow), (nextCol)).Select
    Cells((currentRow), (nextCol)) = fileDate2
    End If
Next

New code:

For currentRow = 1 To rowCount
    if Cells(currentRow, nextCol).Value = "" then
        Cells(currentRow,nextCol).Value = fileDate2
    End If
Next

Answer 2

Try this:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

YOUR CODE HERE

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

Answer 3

Few things that I noticed

1. As mentioned by Chris in comments, you can turn off screen updating and set calculation to manual and switch them back on and set calculation to automatic at the end of the code.

For Example

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'
'~~> Rest of your code
'
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

2. Avoid the use of .Select. it reduces the speed of the code. You do not need to select the cell to write to it.

Your For Loop can be written as.

For currentRow = 1 To RowCount
    If Cells(currentRow, nextCol).Value = "" Then
        Cells(currentRow, nextCol).Value = fileDate2
    End If
Next

This it self will increase the speed of your code as you are not selecting the cell anymore before writing to it.

3. Ideally I would copy the range to an array and then do what you are doing with the array and then write it back to the cell but then that is me.

4. Remove unnecessary lines of code. ActiveWindow.SmallScroll Down:=0 is not needed.

5. Work with object(s) and fully qualify your object(s).

6. When working with Excel rows, use Long instead of Integer