Speed up write from Excel to Access

The procedure below is run in an Excel module. In it several dependent variables which are functions of ten independent variables are calculated and written to Access. There are ten nested For loops; therefore, this procedure calculates tens of millions of values and writes millions of records to Access. This takes FOREVER so I'd like to employ the fastest way to write to Access.

I'm currently using dbs.CurrentDb.Execute "INSERT INTO ... VALUES ...".

aikimark suggested using recordsets instead of INSERT INTO. The new procedure using recordsets is in the code snippet. This procedure is MUCH slower than the same procedure using INSERT INTO ... VALUES ....

Is this to be expected or am I doing something wrong? Is there a way to speed up the code in the code snippet?

NOTE: I tried CSV files which are faster than either the recordset approach or the INSERT INTO approach but for some reason some decimal values are truncated to integer values which isn't acceptable.
Sub CostLoop()

	Set g_objConn = New ADODB.Connection
	g_objConn.Open g_sConnectionString

	Set rs = New ADODB.Recordset
	rs.Open "tbl", g_objConn, adOpenDynamic, adLockPessimistic

	For iCounter1 = 1 to (...)
		For iCounter2 = 1 to (...)
			For iCounter3 = 1 to (...)


				For iCounter10 =
					iRecordCounter = iRecordCounter + 1
					If iRecordcounter = 1 Then g_objConn.BeginTrans
					dOutput1 = (...)
					dOutput2 = (...)
					dOutput3 = (...)
					dOutput10 = (...)


    					'ASSIGN FIELDS IN TABLE rs!<columnname in table> = <value>
    					rs!Variable1 = iCounter1
    					rs!Variable2 = iCounter2
    					rs!Variable3 = iCounter3
    					rs!Variable4 = iCounter4
    					rs!Variable5 = iCounter5
    					rs!Variable6 = iCounter6
    					rs!Variable7 = iCounter7
    					rs!Variable8 = iCounter8
    					rs!Variable9 = iCounter9
    					rs!Variable10 = iCounter10
    					rs!Output1 = dOutput1
    					rs!Output2 = dOutput2
    					rs!Output3 = dOutput3
    					rs!Output4 = dOutput4
    					rs!Output5 = dOutput5
    					rs!Output6 = dOutput6
    					rs!Output7 = dOutput7
    					rs!Output8 = dOutput8
    					rs!Output9 = dOutput9
    					rs!Output10 = dOutput10

    					'ISSUE THE ADD

					If iRecordCounter = 100 Then
						iRecordCounter = 0
					End If

				Next iCounter10
			Next iCounter3
		Next iCounter2
	Next iCounter1


	Set rs = Nothing

End Sub

Open in new window

Who is Participating?
inthedarkConnect With a Mentor Commented:
Here are 8 suggestions to improve your code speed.
Before you do any changes start with item 1 and see how each part of your code performs. Then start to make speed mods.

Hope this helps:~)

1) Profile the phases of the code using GetTickCounter


Dim StartProc1 as Currency
Dim Proc1Time as Currency
Dim StartProc2 as Currency
Dim Proc2Time as Currency

StartProc1 = GetTickCounter

'some code here to create the values for the recordset

dOutput1 = (...)
dOutput2 = (...)

StartProc2 = GetTickCounter

Proc1Time = Proc1Time + StartProc2 - StartProc1 ' Accumulate time between start and end of phase

'some other code here to move data into recordset

rs!Variable1 = iCounter1
rs!Variable2 = iCounter2
StartProc3 = GetTickCounter
Proc2Time = Proc2Time + StartProc3-StartProc2

When the job is complete you can then see how much time was spent in each part of the code so can then be sure how much time you are saving on each part.

At the end of the sub:

sMes = "CreatingSaveData= "+cstr(ProcessXTime)+vbcrlf
sMes=sMes + "RecordUpdates="+cstr(ProcessYTime)+vbcrlf
Clipboard.SetText sMes

stop ' past the result into a spreadsheet

2) Excel is very slow at getting data; so pick up all of the data in a sheet in one hit:

Dim DT

' Select all data in a worksheet
EA.ActiveSheet.Cells.Select ' Where EA is your Excel.Application object

' Move the daya to an array
DT = EA.Selection.Value

The problem with the above is that you get every possible cell which is a huge array so really it is better to just pick up the data for a block of rows (say 100 at a time until you find all empty cells).

DT = EA.ActiveSheet.Range("A" + CStr(lStartRow)).Resize(lNumberOfRowsToGet, lNumberOfColumnsToGet).Value

Now when you are working you can access the cells in the sheet without needing to constantly link with the Excel Application Objects. This will make the calculation part really quick.

3) When you save the data make a field array to reduce binding to your recordset.

' After the rs.Open
Dim MyFiedlds() As ADODB.Field

ReDim MyFields(RS.Fields.Count-1)
Set MyFields(0) = rs!Variable1
Set MyFields(1) = rs!Variable2

Dim lMaxFields As Long

lMaxFields = 29 ' set up the last used element of MyFields()

' Now when you update your recordset

Dim lC as Long

' Update the recordset

With RS

    For lC = 0 To lMaxFields
        MyFields(lc) = Uutput(lC)

    StartProcUpdate = GetTickCounter
    .UpdateBatch ' (or use .Update)
    ProcUpdateTime = ProcUpdateTime + GetTickCounter - StartProcUpdate

End With

You dont need to use an array you can use field names if you like doing lots of typing:

Dim MyFieldValueOfStuff As Field
Dim MyFieldOtherStuff As Field

Set MyFieldValueOfStuff = RS!ValueOfStuff
Set MyFieldOtherStuff = RS!OtherStuff

4) In your example you batched the updates into blocks of 100 rows but I would experiment by using the profiling becuase you may find that 1 record may work quicker then 100 - by profiling the tickcounts you will know exactly.

5) All counter fields like iCounter1 should be Dim iCounter1 as Long
Because the CPU can work faster with Longs then Integers

Also make sure that your module Declarations start with Option Explicit if it is not already there.

5) You should be using adCmdTableDirect, adLockOptimistic

6) In your example you are using ADODB but by using DAO your .update code will work about 2000 times faster into an access database. At least when I did the timings on ADODB when it first came out DAO was 2000 times faster in my insert records example.

Set a project reference to Microsoft DAO.

Open can use the open table direct and also the append only options on DAO:

Dim DB as DAO.Database
Dim RS As DAO.Recordset

Set DB = Workspaces(0).OpenDatabase("C:\MyFolder\MyDB.MDB")

Set RS = DB.OpenRecordset(SQL, dbOpenTable, dbAppendOnly + dbOptemistic)

Item 3 using the set arrayelement(x) = field will also work in DAO
7)  In a loop you want to avoid calling functions to get your data:

dOutput1 = SomeFunction(SomeParameters,etc.....)

Now that you have your data in an array you can put a result directly into your recordset


MyFieldValueOfStuff = DT(lMyRow, lMyColumn)

Or you may need to do calculations, do them without calling a sub or function
Dim Result As Currency

Result =DT(lMyRow, lMyColumn) * 100 /DT(lMyRow, lMyColumn+1)
MyFieldValueOfStuff = Result


When yoiu call a function the CPU has to do a whole bunch of stuff like pushing a whole lot of registers on the stack, then pushing pointers to parameters onto the stack and return addresses, etc. then stacking them.

You can use a simple Gosub MyInteralSub it is much faster than calling subs or functions but will not win you any lovely code points.
8) CSV would be the fastest method. To avoid loss of data you simply need to use Format.

' Setup

lFile = FreeFile
Open "C:\MyFolder\MyFile.csv" For Output As lFile

Dim sQuote As String
sQuote = """"
dim sComma As String
sComma = ","

' Save a record

Print lFile, sQuote;"MyStringValue";sQuote;sComma;Format(DT(lRow,lMyFieldCol,"0.00");sComma;
' More fields
Print lFile, Format(DT(lRow, lNextField);vbCRLF; ' last field needs no commad as it has CRLF

' after the loops complete close the file

close lFile

Be sure to check the output using notepad; if you view in excel excel make sure you format each column with enough decimals.

-----------------------------------------GetTickCounter function
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Function GetTickCounter() As Currency
GetTickCounter = CCur(GetTickCount)
End Function
aikimarkConnect With a Mentor Commented:
to follow up on the excellent inthedark comment above...

* start testing your commits at 500 iterations.  There likely be some point before you get to the 1000 iteration interval where you won't see much better performance.

* What are the upper limits of each of these For...Next loops?  If you are using 10 for each, then you are trying to insert 10 billion rows, not millions or tens of millions.  I'm surprised that you have exceeded one or more Access limits (including the use of a CSV intermediary file).

* WHY are you doing this?
Good point aikmark, it would seem to me that an entire spreadsheet can only be a few thousand rows which would import into a database within a few seconds, I would estimate about 200 rows per second.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.