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.


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