Excel vba speed optimization for importing data from excel to excel table -

having trouble speed of vba script importing data excel table. hoping here can help. comments in code state script takes 8 seconds import 100 rows of data. love bring down fractions of second.

sub importmydata()     dim filter, caption, importfilename string     dim importwb workbook     dim targetsh, validationsh worksheet     dim targettb listobject     dim importrg, targetrg, validationrg range     dim i, j, k, targetstartrow integer      ' set speed related application settings (this restored on exit)     application         .screenupdating = false         .calculation = xlcalculationmanual         .displaystatusbar = false         .enableevents = false     end      ' 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 file choose dialog     filter = "text files (*.xlsx),*.xlsx"      ' set ui text file choose dialog     caption = "chose xlsx file import "      ' set filename ui dialog     importfilename = application.getopenfilename(filter, , caption)       ' show form user input field (will return variable 'mychoice')     importformpicker.show      ' open 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      ' starting row of imported target range future reference     targetstartrow = targettb.listrows.count + 1      ' iterate rows in import range     = 1 importrg.rows.count         ' import row if first cell in row date         if isdate(importrg.cells(i, 1).value)             ' count imported rows             k = k + 1             ' insert row @ end of target table             targettb.listrows.add alwaysinsert:=true             ' iterate columns in import range             j = 1 importrg.columns.count                 targetrg.cells(targettb.listrows.count, j)                     ' import value                     .value = importrg.cells(i, j).value                     ' set format according validation range                     .numberformat = validationrg.cells(2, j).numberformat                 end             next j             targetrg.cells(targettb.listrows.count, j)                 ' add custom value determined user form                 .value = butik                 ' set format according validation range                 .numberformat = validationrg.cells(2, j).numberformat             end             ' --- speed troubleshooting = 100 rows imported/~8seconds.             if mod 100 = 0                 thisworkbook.activate             end if             ' --- end speed troubleshooting         end if     next      ' close import file workbook without saving     importwb.close savechanges:=false      ' protect target sheet     targetsh         ' protect target sheet         .protect drawingobjects:=true, contents:=true, scenarios:=true         ' show target sheet         .visible = true         ' activate target sheet         .activate     end      ' select imported range     targetrg.range(cells(targetstartrow, 1), cells(targettb.listrows.count, j)).select      ' show user how many rows imported     msgbox ("imported " & k & " rows.")      ' restore speed related settings     application         .screenupdating = true         .calculation = xlcalculationautomatic         .displaystatusbar = true         .enableevents = true     end end sub 

something this, sorry variable names, did whilst on call, you'll need adjust

sub test()  dim q querytable dim r new adodb.recordset dim c new adodb.connection dim s string  s = "provider=microsoft.ace.oledb.12.0;data source=c:\test\test_conn.xlsx;" & _             "extended properties='excel 12.0 xml;hdr=yes';" c.connectionstring = s c.open  r.open "select * [sheet1$];", c, 1  activesheet.querytables.add( _         connection:=r, _         destination:=range("z1"))     .name = "contact list"     .fieldnames = true     .rownumbers = false     .filladjacentformulas = false     .preserveformatting = true     .refreshonfileopen = false     .backgroundquery = true     .refreshstyle = xlinsertdeletecells     .savepassword = true     .savedata = true     .adjustcolumnwidth = true     .refreshperiod = 0     .preservecolumninfo = true     .refresh backgroundquery:=false  end   end sub