Having trouble with speed of a vba script for importing data into an excel table. Hoping someone here can help. As the comments in my code state this script takes about 8 seconds to import 100 rows of data. I would love to bring it down to fractions of a second.
Code:
Sub ImportMyData() Dim filter, caption, importFileName As String
Dim importWb As Workbook
Dim targetSh, validationSh As Worksheet
Dim targetTb As ListObject
Dim importRg, targetRg, validationRg As Range
Dim i, j, k, targetStartRow As Integer
' Set speed related application settings (this will be restored on exit)
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayStatusBar = False
.EnableEvents = False
End With
' Set definitions
Set targetSh = ThisWorkbook.Sheets("myTargetSheet")
Set targetTb = targetSh.ListObjects("myTargetTable")
Set targetRg = targetTb.DataBodyRange
Set validationSh = ThisWorkbook.Sheets("myValidationSheet")
Set validationRg = validationSh.Range("myValidationRange")
' Set filter for the file choose dialog
filter = "Text files (*.xlsx),*.xlsx"
' Set UI text for file choose dialog
caption = "Chose xlsx file to import "
' Set filename from UI dialog
importFileName = Application.GetOpenFilename(Filter, , Caption)
' Show Form to get user input for extra field (will return variable 'myChoice')
ImportFormPicker.Show
' Open the import file workbook
Set importWb = Application.Workbooks.Open(importFileName)
importWb.Windows(1).Visible = False
targetSh.Activate
' Set definitions
Set importRg = importWb.Worksheets(1).UsedRange
' Unprotects target sheet
targetSh.Unprotect
' Get starting row of imported target range for future reference
targetStartRow = targetTb.ListRows.Count + 1
' Iterate all rows in import range
For i = 1 To importRg.Rows.Count
' Only import row if first cell in row is a date
If IsDate(importRg.Cells(i, 1).Value) Then
' Count imported rows
k = k + 1
' Insert row at end of target table
targetTb.ListRows.Add AlwaysInsert:=True
' Iterate all columns in import range
For j = 1 To importRg.Columns.Count
With targetRg.Cells(targetTb.ListRows.Count, j)
' Import value
.Value = importRg.Cells(i, j).Value
' Set format according to validation range
.NumberFormat = validationRg.Cells(2, j).NumberFormat
End With
Next j
With targetRg.Cells(targetTb.ListRows.Count, j)
' Add custom value which was determined by user form
.Value = Butik
' Set Format according to validation range
.NumberFormat = validationRg.Cells(2, j).NumberFormat
End With
' --- Speed troubleshooting = 100 rows imported/~8seconds.
If i Mod 100 = 0 Then
ThisWorkbook.Activate
End If
' --- End Speed troubleshooting
End If
Next i
' Close the import file workbook without saving
importWb.Close savechanges:=False
' Protect target sheet
With targetSh
' Protect the target sheet
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Show the target sheet
.Visible = True
' Activate the target sheet
.Activate
End With
' Select imported range
targetRg.Range(Cells(targetStartRow, 1), Cells(targetTb.ListRows.Count, j)).Select
' Show user how many rows were imported
MsgBox ("Imported " & k & " rows.")
' Restore speed related settings
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayStatusBar = True
.EnableEvents = True
End With
End Sub