Speeding up VBA Code to Run Faster - vba

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

Few things that I noticed
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
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.
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.
Remove unnecessary lines of code. ActiveWindow.SmallScroll Down:=0 is not needed.
Work with object(s) and fully qualify your object(s).
When working with Excel rows, use Long instead of Integer

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

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