Looping SQL query w/changing parameters in each loop not working

[Laurin]

I have an SQL database that stores millions of mine sample results.
Every quarter selected samples need to be pulled for analysis for
royalty payments. I want to query the SQL database and pull back all
of the relevant results into memory. Then I have the operator scan in
the sample barcode and vba tells the operator (via a userform) which
claim the sample is in and if it needs to be analyzed for this
quarter.

I've posted the relevant portion of the code I am having problems with.
Because of excels row limitation, I have to query the database in
chunks of 65000. I've tested each of these modules individually and
they work. However when put together, the query does not update
itself to get new data when it's conditions have changed.

I want to stay away from having the code query each time a sample is
scanned because the line to the SQL server experiences a high volume of
traffic resulting in a 5 - 10 second wait for each query. So the idea
is that the program runs when the spreadsheet opens and pulls all of
the data into memory. From there the operator can scan and get
instantaneous results.

Any ideas on how to get the query to refresh based on its new
parameters instead of just using the first parameters given in the
first loop? The SQL code was written using the macro recorder so it
isn't pretty but it works. The red text indicates the place where the
conditions are changed for each loop.



Code:
--------------------
SUB COMMANDMODULE()
Dim QueryFlag As Boolean, StartNum As Long, EndNum As Long, Count As Long
QueryFlag = True
Dim ID() As String, Royalty() As Integer, Class() As Integer, MineDate() As Long
Do Until QueryFlag = False
StartNum = EndNum + 1
EndNum = StartNum + 64999
Call ChangeCondition(StartNum, EndNum)
Call Query
Call LoadArray(QueryFlag, ID, Royalty, Class, MineDate, Count)
Call DeleteQuery
Loop

End Sub

SUB CHANGECONDITION(STARTNUM, ENDNUM)

Dim First As String, Last As String, Line7 As String

Select Case Len(StartNum)
Case Is = 1: First = "MOPB00000" & StartNum
Case Is = 2: First = "MOPB0000" & StartNum
Case Is = 3: First = "MOPB000" & StartNum
Case Is = 4: First = "MOPB00" & StartNum
Case Is = 5: First = "MOPB0" & StartNum
Case Else: First = "MOPB" & StartNum
End Select

Select Case Len(EndNum)
Case Is = 1: Last = "MOPB00000" & EndNum
Case Is = 2: Last = "MOPB0000" & EndNum
Case Is = 3: Last = "MOPB000" & EndNum
Case Is = 4: Last = "MOPB00" & EndNum
Case Is = 5: Last = "MOPB0" & EndNum
Case Else: Last = "MOPB" & EndNum
End Select

Line7 = " .CommandText = Array(" & Chr(34) & "SELECT sstn_surface_samples.sample_number, sstn_surface_samples.Royalty, sstn_surface_samples.Type, sstn_surface_samples.Mined" & Chr(34) & " & Chr(13) & " & Chr(34) & Chr(34) & " & Chr(10) & " & Chr(34) & "FROM Fusion_Central.dbo.sstn_surface_samples sstn_surface_samples" & Chr(34) & " & Chr(13) & " & Chr(34) & Chr(34) & " & Chr(10) & " & Chr(34) & "WHERE" & Chr(34) & ", " & Chr(34) & " (sstn_surface_samples.sample_number>='" & First & "' And sstn_surface_samples.sample_number<='" & Last & "')" & Chr(34) & ")"
Application.VBE.ActiveVBProject.VBComponents("d_Query").CodeModule.ReplaceLine 7, Line7

End Sub

SUB QUERY()
ThisWorkbook.Worksheets("Query").Activate
With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=central;UID=admin;PWD=xyz;APP=Microsoft Office 2003;WSID=USCCWEBMETLURGI;DATABASE=Fusion_Central;Network=DBMSSOCN", Destination:=Range("A1"))
.CommandText = Array("SELECT sstn_surface_samples.sample_number, sstn_surface_samples.Royalty, sstn_surface_samples.Type, sstn_surface_samples.Mined" & Chr(13) & "" & Chr(10) & "FROM Fusion_Central.dbo.sstn_surface_samples sstn_surface_samples" & Chr(13) & "" & Chr(10) & "WHERE", " (sstn_surface_samples.sample_number>='MOPB000001' And sstn_surface_samples.sample_number<='MOPB065000')")
.Name = "Query from central"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = True
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With

End Sub

SUB LOADARRAY(QUERYFLAG, ID, ROYALTY, CLASS, MINEDATE, COUNT)
Range("A2").Select
If Selection.Value = "" Then
QueryFlag = False
Exit Sub
End If

Dim J As Long, v As Variant, OldCount As Long
Range(Selection, Selection.Offset(0, 3)).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Name = "Data"
v = [Data]
OldCount = Count
Count = Count + UBound(v, 1)
ReDim Preserve ID(Count)
ReDim Preserve Royalty(Count)
ReDim Preserve Class(Count)
ReDim Preserve MineDate(Count)
For J = 1 To UBound(v, 1)
ID(J + OldCount) = v(J, 1)
Royalty(J + OldCount) = v(J, 2)
Class(J + OldCount) = v(J, 3)
MineDate(J + OldCount) = v(J, 4)
Next J

'***I've tried using the following 4 lines of code and and also commenting it out and either way it is not helpful.***

Dim TheName As Name
For Each TheName In ActiveWorkbook.Names
TheName.Delete
Next

End Sub

SUB DELETEQUERY()

Application.Worksheets("Query").Activate
Cells.Select
Selection.ClearContents
On Error Resume Next
Selection.QueryTable.Delete

End Sub

 

[DM Unseen]

There is alot of room for improvement:

You need to investigate the parameters collection of the querytable and
write a Query like this:

"SELECT sstn_surface_samples.sample_number,
sstn_surface_samples.Royalty, sstn_surface_samples.Type,
sstn_surface_samples.Mined FROM Fusion_Central.dbo.sstn_surface_samples
sstn_surface_samples
WHERE (sstn_surface_samples.sample_number>= ? And
sstn_surface_samples.sample_number<= ?)"

Now add two parameters to the collection and refresh your query. Note
that parameter markers(="?") might be different for your database
system ("?" works for SQL server)

I would not create the Query by code and delete it. Just create it
once, and then only change the parameters after that.

Use the querytable events (Before and afterrefresh) to execute VBA that
needs to go before or after refreshing the query. This way you can also
refresh data by hand as well. This event can be used to check
rowoverflow.

DM Unseen

 

[Laurin]

Thanks. So something like the following?


Code:
--------------------
Dim qt As QueryTable
sqlstring = "select 96Sales.totals from 96Sales where profit < 5"
connstring = _
"ODBC;DSN=96SalesData;UID=Rep21;PWD=NUyHwYQI;Database=96Sales"
With ActiveSheet.QueryTables.Add(Connection:=connstring, _
Destination:=Range("B1"), Sql:=sqlstring)
.Refresh
End With

 

[Laurin]

Thanks much DM Unseen! Your insight was key to getting the following
code to work. Just seems too bad that you have to use an excel sheet
range as opposed to a variable to automatically change the parameter.

thanks again!


Code:
--------------------
SUB LOOPINGQUERY()
Dim qt As QueryTable, Param1 As Parameter, Param2 As Parameter
Dim sqlstring As String, connstring As String
Dim StartNum As Variant, EndNum As Variant, First As String, Last As String
Dim Count As Long
Dim ID() As String
Dim Royalty() As Integer
Dim Class() As Integer
Dim MineDate() As Long

'*** Setting up the query table ***
ThisWorkbook.Worksheets("Query").Activate
sqlstring = "SELECT sstn_surface_samples.sample_number, sstn_surface_samples.Royalty, sstn_surface_samples.Type, sstn_surface_samples.Mined FROM Fusion_Central.dbo.sstn_surface_samples sstn_surface_samples WHERE (sstn_surface_samples.sample_number>=? AND sstn_surface_samples.sample_number<=?)"
connstring = "ODBC;DSN=central;UID=admin;PWD=xyz;APP=Microsoft Office 2003;WSID=USCCWEBMETLURGI;DATABASE=Fusion_Central;Network=DBMSSOCN"

With ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Range("A1"), Sql:=sqlstring)
End With
Set qt = Sheets("Query").QueryTables(1)

'*** Looping through the samples in the Database _
'*** in chunks of 65,000 and loading them into the _
'*** appropriate arrays ***

Do

StartNum = EndNum + 1
EndNum = StartNum + 64999
Select Case Len(StartNum)
Case Is = 1: First = "MOPB00000" & StartNum
Case Is = 2: First = "MOPB0000" & StartNum
Case Is = 3: First = "MOPB000" & StartNum
Case Is = 4: First = "MOPB00" & StartNum
Case Is = 5: First = "MOPB0" & StartNum
Case Else: First = "MOPB" & StartNum
End Select

Select Case Len(EndNum)
Case Is = 1: Last = "MOPB00000" & EndNum
Case Is = 2: Last = "MOPB0000" & EndNum
Case Is = 3: Last = "MOPB000" & EndNum
Case Is = 4: Last = "MOPB00" & EndNum
Case Is = 5: Last = "MOPB0" & EndNum
Case Else: Last = "MOPB" & EndNum
End Select

Application.ThisWorkbook.Worksheets("Query").Range("I1") = First
Application.ThisWorkbook.Worksheets("Query").Range("I2") = Last

Set Param1 = qt.Parameters.Add(First, xlParamTypeVarChar)
Param1.SetParam xlRange, Range("Query!I1")
Set Param2 = qt.Parameters.Add(Last, xlParamTypeVarChar)
Param2.SetParam xlRange, Range("Query!I2")

With qt
.RefreshStyle = xlOverwriteCells
.BackgroundQuery = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With

Range("A2").Select
If Selection.Value = "" Then Exit Do

Dim J As Long, v As Variant, OldCount As Long
Range(Selection, Selection.Offset(0, 3)).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Name = "Data"
v = [Data]
OldCount = Count
Count = Count + UBound(v, 1)
ReDim Preserve ID(Count)
ReDim Preserve Royalty(Count)
ReDim Preserve Class(Count)
ReDim Preserve MineDate(Count)
For J = 1 To UBound(v, 1)
ID(J + OldCount) = v(J, 1)
Royalty(J + OldCount) = v(J, 2)
Class(J + OldCount) = v(J, 3)
MineDate(J + OldCount) = v(J, 4)
Next J

Loop


End Sub

 

[DM Unseen]

You could change:

Application.ThisWorkbook.Worksheets("Query").Range("I1") = First
Application.ThisWorkbook.Worksheets("Query").Range("I2") = Last

Set Param1 = qt.Parameters.Add(First, xlParamTypeVarChar)
Param1.SetParam xlRange, Range("Query!I1")
Set Param2 = qt.Parameters.Add(Last, xlParamTypeVarChar)
Param2.SetParam xlRange, Range("Query!I2")

TO

set this code before the loop
Set Param1 = qt.Parameters.Add("First", xlConstant )
Set Param2 = qt.Parameters.Add("Last", xlConstant )


Set this code in the loop

Param1.SetParam xlConstant , First
Param2.SetParam xlConstant , Last

Thsi way you defined the parameters only once and just fill them
directly without a range

Dm Unseen

 

[Andrew Taylor]

..

Select Case Len(StartNum)
Case Is = 1: First = "MOPB00000" & StartNum
Case Is = 2: First = "MOPB0000" & StartNum
Case Is = 3: First = "MOPB000" & StartNum
Case Is = 4: First = "MOPB00" & StartNum
Case Is = 5: First = "MOPB0" & StartNum
Case Else: First = "MOPB" & StartNum
End Select

You can simplify this (and the similar code for EndNum) by writing:

First = "MOPB" & Format(StartNum, "000000")

 

[Laurin]

Even better. Thanks!

 

[Laurin]

So the final code boils down to less than a page. Thanks for the tips.


Code:
--------------------
Sub loopingquery()

Dim qt As QueryTable, Param1 As Parameter, Param2 As Parameter
Dim sqlstring As String, connstring As String
Dim StartNum As Variant, EndNum As Variant, First As String, Last As String
Dim Count As Long
Dim J As Long, v As Variant, OldCount As Long

'*** Setting up the query table ***
ThisWorkbook.Worksheets("Query").Activate
sqlstring = "SELECT sstn_surface_samples.sample_number, sstn_surface_samples.Royalty, sstn_surface_samples.Type, sstn_surface_samples.Mined FROM Fusion_Central.dbo.sstn_surface_samples sstn_surface_samples WHERE (sstn_surface_samples.sample_number>=? AND sstn_surface_samples.sample_number<=?)"
connstring = "ODBC;DSN=central;UID=admin;PWD=xyz;APP=Microsoft Office 2003;WSID=USCCWEBMETLURGI;DATABASE=Fusion_Central;Network=DBMSSOCN"

With ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Range("A1"), Sql:=sqlstring)
End With

Set qt = Sheets("Query").QueryTables(1)
Set Param1 = qt.Parameters.Add("First", xlConstant)
Set Param2 = qt.Parameters.Add("Last", xlConstant)

'*** Looping through the samples in the Database _
'*** in chunks of 65,000 and loading them into the _
'*** appropriate arrays ***

Do

StartNum = EndNum + 1
EndNum = StartNum + 64999

First = "MOPB" & Format(StartNum, "000000")
Last = "MOPB" & Format(EndNum, "000000")

Param1.SetParam xlConstant, First
Param2.SetParam xlConstant, Last

With qt
.RefreshStyle = xlOverwriteCells
.BackgroundQuery = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With

Range("A2").Select
If Selection.Value = "" Then Exit Do

Range(Selection, Selection.Offset(0, 3)).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Name = "Data"
v = [Data]
OldCount = Count
Count = Count + UBound(v, 1)
ReDim Preserve ID(Count)
ReDim Preserve Royalty(Count)
ReDim Preserve Class(Count)
ReDim Preserve MineDate(Count)
For J = 1 To UBound(v, 1)
ID(J + OldCount) = v(J, 1)
Royalty(J + OldCount) = v(J, 2)
Class(J + OldCount) = v(J, 3)
MineDate(J + OldCount) = v(J, 4)
Next J

Loop