Speeding up a ms access sql query from excel - sql

Question

I have the code below and it seems to be taking a while to open the recordset and run the query attached (62 seconds to be exact). While 1 minute is fine, when I need to do this 13 times, it begins to take a long time to run the code.
I've debugged the code down to just the opening of the recordset taking the longest time.
My question is: Is there a method to run this faster? (i'm connecting to MS Access 2013 from Excel 2013)
Thanks in advance,
Rich
Sub GetUnits2()
'Declaring the necessary variables.
Dim con As Object
Dim rs As Object
Dim AccessFile As String
Dim strTable As String
Dim SQL As String
Dim myValues() As Variant
Dim i As Long
Dim k As Long
Dim j As Integer
Dim SheetName As String
Dim WeekNumber As Long
Dim year As Long
Dim Model1 As String
Dim Model2 As String
Dim xlrow As Integer
Dim xlcol As Integer
SheetName = "Sheet2"
Sheets(SheetName).Select
Model1 = Sheets(SheetName).Cells(3, 2).Value
Model2 = Sheets(SheetName).Cells(4, 2).Value
'Disable screen flickering.
Application.ScreenUpdating = False
'Specify the file path of the accdb file. You can also use the full path of the file like:
AccessFile = "C:\Users\rich.wolff\Desktop\2014POSDatabase\HMKPOSDatabase2014.accdb"
On Error Resume Next
'Create the ADODB connection object.
Set con = CreateObject("ADODB.connection")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0
'Open the connection.
con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
'Set Current Week, Year, & Starting Cell
WeekNumber = Sheets(SheetName).Cells(8, 14).Value
year = Sheets(SheetName).Cells(9, 14).Value
xlcol = 14 'Starting Column
xlrow = 11 'Starting Row
'Open Query Loop
For k = 1 To 1
SQL = "SELECT Sum(StoreSalesData.QTY) AS Units"
SQL = SQL & " FROM VSNConversionData INNER JOIN ([Sleepys Store List] INNER JOIN StoreSalesData ON [Sleepys Store List].[Store Code] = StoreSalesData.STR) ON VSNConversionData.VSN = StoreSalesData.VSN"
SQL = SQL & " WHERE (((VSNConversionData.VSNStyle)='" & Model2 & "') AND ((StoreSalesData.WeekNum)=" & WeekNumber & ") AND ((StoreSalesData.Year)=" & year & ") AND ((StoreSalesData.STR) In (SELECT FloorModels2.[Source Org]"
SQL = SQL & " FROM FloorModels2"
SQL = SQL & " WHERE (((FloorModels2.[Source Org]) In (SELECT FloorModels2.[Source Org]"
SQL = SQL & " FROM FloorModels2"
SQL = SQL & " WHERE (((FloorModels2.WeekNumber)=" & WeekNumber & ") AND ((FloorModels2.Year)=" & year & ") AND ((FloorModels2.VSNStyle)='" & Model1 & "')))) AND ((FloorModels2.WeekNumber)=" & WeekNumber & ") AND ((FloorModels2.Year)=" & year & ") AND ((FloorModels2.VSNStyle)='" & Model2 & "')))));"
On Error Resume Next
'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.recordset")
'Check if the object was created.
If Err.Number <> 0 Then
Set rs = Nothing
Set con = Nothing
MsgBox "Connection was not created!", vbCritical, "Connection error"
Exit Sub
End If
On Error GoTo 0
'Set thee cursor location.
rs.CursorLocation = 3 'adUseClient on early binding
rs.CursorType = 1 'adOpenKeyset on early binding
'Open the recordset.
rs.Open SQL, con
'Redim the table that will contain the filtered data.
ReDim myValues(rs.RecordCount)
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Dim dbcol As Integer
dbcol = 0
Worksheets(SheetName).Cells(xlrow, xlcol).ClearContents
Worksheets(SheetName).Cells(xlrow, xlcol).Value = rs(dbcol).Value
Else
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
Application.ScreenUpdating = True
MsgBox "There are no records in the recordset!", vbCritical, "No Records"
Exit Sub
End If
'Close the recordet
rs.Close
Set rs = Nothing
If WeekNumber = 1 Then
year = year - 1
WeekNumber = 52
Else
year = year
WeekNumber = WeekNumber - 1
End If
' Next Column
xlcol = xlcol - 1
Next
'End Query Loop
con.Close
Set rs = Nothing
Set con = Nothing
Application.ScreenUpdating = True
End Sub

Answer 1

Have I wandered accidentally into a PHP forum?
Declare the ADODB libraries using tools:references - they will run faster, you get intellisense and a listing of all the available properties and options in the Object Browser, and you gain the ability to run the query asynchronously.
That's Early-Binding, an improvement on Late-Binding.
Next, open the Recordset object with dbForwardOnly (slightly faster) and dump it into a VBA array variant with the Recordset.GetRows method: transpose the array in your code, and write it to the range.
I can see that you've made progress on optmising the SQL: try saving it as a parameter query in the database. The ADODB.Command object can open a named query, populate the parameters, and return a recordset - the query itself may or may not run faster, but the lead time to parse the SQL will be significantly faster.

Answer 2

You could try:
Sub M_snb()
c00 = "C:\Users\rich.wolff\Desktop\2014POSDatabase\HMKPOSDatabase2014.accdb"
With Sheets("sheet2")
sn = Array(.Cells(3, 2), .Cells(4, 2), .Cells(8, 14), .Cells(9, 14)) ' model 1, model 2, weeknumber, year
End With
For j = 1 To 13
c01 = "SELECT Sum(StoreSalesData.QTY) AS Units"
c01 = c01 & " FROM VSNConversionData INNER JOIN ([Sleepys Store List] INNER JOIN StoreSalesData ON [Sleepys Store List].[Store Code] = StoreSalesData.STR) ON VSNConversionData.VSN = StoreSalesData.VSN"
c01 = c01 & " WHERE (((VSNConversionData.VSNStyle)='" & sn(1) & "') AND ((StoreSalesData.WeekNum)=" & sn(2) & ") AND ((StoreSalesData.Year)=" & sn(3) & ") AND ((StoreSalesData.STR) In (SELECT FloorModels2.[Source Org]"
c01 = c01 & " FROM FloorModels2"
c01 = c01 & " WHERE (((FloorModels2.[Source Org]) In (SELECT FloorModels2.[Source Org]"
c01 = c01 & " FROM FloorModels2"
c01 = c01 & " WHERE (((FloorModels2.WeekNumber)=" & sn(2) & ") AND ((FloorModels2.Year)=" & sn(3) & ") AND ((FloorModels2.VSNStyle)='" & sn(0) & "')))) AND ((FloorModels2.WeekNumber)=" & sn(2) & ") AND ((FloorModels2.Year)=" & sn(3) & ") AND ((FloorModels2.VSNStyle)='" & sn(1) & "')))));"
With CreateObject("ADODB.recordset")
.Open c01, "Provider=Microsoft.Jet.OLEDB.12.0;Data Source=" & c00
Sheets("sheets2").Cells(11, 14 + j).CopyFromRecordset .DataSource
End With
Next
End Sub