Excel-vba optimizing speed when importing data from excel sheet to excel table

ggwptyvm

New Member
Joined
Jun 29, 2016
Messages
2
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
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
What exactly are you importing?

Do you really need the 2nd loop that goes through columns?

Couldn't you just import the entire row?
 
Upvote 0
Ill give you an example of how the rows look

Code:
2016-01-01,Some Product Name, 292, 2.02, Some Currency

The 2nd loop sets the number format for each column based on a validationrange where those formats are defined.

1. Would it be faster to import each row as you suggest and then set the number format for the entire range afterwards?
2. How do I set the value of the entire row without using copy, which I understand takes significantly longer time. Can I do range(cells(i,1),cells(i,j).value = targetRow.value ? Ive never fully grasped how this works in vba. singlecell.value = othersinglecell.value is easier to understand for me.
 
Upvote 0
Copying an entire row and applying formatting to the entire range at the end is probably going to be quicker than transferring the values and applying the formatting for 5 columns one by one.

If you are really against copying you could just transfer the 5 values in one go.

That might look something like this.
Code:
With targetRg.Cells(targetTb.ListRows.Count, j).Resize(,5)
     ' Import values
    .Value = importRg.Cells(i, j).Resize(,5).Value
End With
You might be able to apply the formatting in one go to using PasteSpecial.
 
Upvote 0

Forum statistics

Threads
1,215,374
Messages
6,124,574
Members
449,173
Latest member
Kon123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top