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!
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.
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.
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:=0is not needed.
Work with object(s) and fully qualify your object(s).
When working with Excel rows, use
Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False YOUR CODE HERE Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.EnableEvents = True
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.
For currentRow = 1 To rowCount currentRowValue = Cells(currentRow, nextCol).Value If currentRowValue = "" Then Cells((currentRow), (nextCol)).Select Cells((currentRow), (nextCol)) = fileDate2 End If Next
For currentRow = 1 To rowCount if Cells(currentRow, nextCol).Value = "" then Cells(currentRow,nextCol).Value = fileDate2 End If Next