Clever Geek Handbook

Speeding up VBA code for fast startup

I have an Excel workbook where the user is importing a text file with a click of a button. My code works exactly as I need it, but it is very slow when column H, Read Date is populated. This is what looks like in my Excel workbook when the text file was imported into the excel sheet: enter image description here

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 import of the reading date, I would really appreciate it! Thanks in advance!

+3


source to share


3 answers


Several things I noticed

  • As mentioned in Chris's comments, you can turn off screen refresh and set the calculation to manual, then turn it on and set automatic calculation at the end of the code.

Example

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

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

    . this reduces the speed of the code. You don't have to select a cell to write to.


Your loop For

can be written as.

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

This alone will speed up your code as you no longer select a cell before writing to it.

  1. Ideally, I would copy the range into an array, then do what you do with the array, and then write it back to the cell, but then that's me.

  2. Remove unnecessary lines of code. ActiveWindow.SmallScroll Down:=0

    not required.

  3. Work with objects (s) and fully qualify your object (s).

  4. When working with Excel rows, use Long

    insteadInteger

+2


source


Try the following:



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

YOUR CODE HERE

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


source


The best solution depends on a few things that I don't understand from the data provided. The next change will speed it up a lot (cell selection takes a long time), but it is not optimal. If it is still slowing down, specify the ~ number of rows and ~% rows (in column H) that are filled in before you move on to the next code. Then, either finding the missing values ​​or (probably in most cases) copying the H column into the array and copying after the values ​​are updated 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
0


source






More articles:


All Articles