Memory issues using querytable for combobox source 1

[ZenRaven]

I've got a combobox that dynamically updates it's selection list based on previous selections. I've got this working pretty good. The problem is that every time I refresh the querytable, the memory usage goes up. Eventually, this would become a big problem if not addressed. After some searching I found this post on another site ( [URL unfurl="true"]http://www.ozgrid.com/forum/showthread.php?t=61780 [/url]) that says MS Query does in fact have memory issues and to use ADO instead.

My questions are:
1. Is the memory usage accusation against using the QueryTable correct?
2. If not, how do I address the memory issues I am seeing?
3. Either way, if I switched to using ADO and added the reference to my template file, would that cause any issues on the end-user's side when they use the file?

Here's the code that move's my combobox and refreshes the querytable/range/box selection if that helps any.

(btw, I'm also always up for constructive criticism of my code)

Public Sub Move_cbCategory(aRange As Range)
  Dim Obj As OLEObject
  Dim c As Integer
  Dim wsFiltered As Worksheet
  Dim wsSelections As Worksheet
  Dim sSQL As String
  Dim SelAddr As String
  Dim SelValue As String
  Dim sText As String
  Dim iLastRow As Integer
  
  Application.ScreenUpdating = False
 
  IgnoreEvents = True
  
  Set Obj = ActiveSheet.OLEObjects("cbCategory")
  Set wsFiltered = Worksheets("Filtered")
  Set wsSelections = Worksheets("Selections")
  
  c = aRange.Column

  sText = aRange.Value
  Obj.LinkedCell = aRange.Address
  
  If c = 6 Then
    sSQL = "select id, parentid, description from categories order by ID"
  Else
    SelAddr = aRange.Address
    SelValue = wsSelections.Range(SelAddr).Offset(0, -1).Value
    sSQL = "select id, parentid, description from categories where parentid = '" & SelValue & "' order by ID"
  End If

  With wsFiltered
    With .QueryTables("qtFiltered")
      .CommandText = sSQL
      .Refresh False
      iLastRow = GetLastRow("Filtered", 3)
      If iLastRow = 1 Then GoTo CLEANUP 'only header row was returned
      Obj.Object.Text = sText
      Names.Add Name:="FilteredCats", RefersToR1C1:="=Filtered!R2C1:R" & iLastRow & "C3"
    End With
    With .Columns(3)
      .AutoFit
      Obj.Object.ListWidth = .Width + 30
      aRange.ColumnWidth = .ColumnWidth + 6
    End With
  End With
  
  With Obj
    .Left = aRange.Left
    .Top = aRange.Top
    .Width = aRange.Width + 1
    .Height = aRange.Height + 1
    .ListFillRange = "FilteredCats"
    .Visible = True
  End With

  IgnoreEvents = False
  
  Application.ScreenUpdating = True
  
CLEANUP:
  Set Obj = Nothing
  Set wsFiltered = Nothing
  Set wsSelections = Nothing

 

[SkipVought]

hi,

1. Is the memory usage accusation against using the QueryTable correct?

Apparently.

3. Either way, if I switched to using ADO and added the reference to my template file, would that cause any issues on the end-user's side when they use the file?

What database are you accessing?

I assume that you are running in an Excel Workbook.



Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[ZenRaven]

Hey Skip, I had a feeling you'd jump on this one.

Your assumption is correct, it is an Excel workbook. The data source I am currently accessing is another sheet within the same workbook. I have a sheet with all selection data, another sheet with my querytable object that filters the 1st sheet, and a named range that I sync with the querytable sheet after it's refreshed.

 

[SkipVought]

You will have to set a reference in the VB Editor, using Tools > References... to Microsoft ActiveX Data Objects n.m Library.

Once set, the application will have those objects exposed so that you can use them.

Here's a sample using ADO to another Excel...

Sub AppendData()
    Dim sConn As String, sSQL As String
    Dim rst As ADODB.Recordset, cnn As ADODB.Connection
    Dim sPath As String, sDB As String
    Dim sh As Range, lRow As Long, wsData As Worksheet
    
    sPath = ActiveWorkbook.Path
    sDB = "Backup July 2006 (Week 5)"
    
    Set cnn = New ADODB.Connection
    
    sConn = "Provider=MSDASQL.1;"
    sConn = sConn & "Persist Security Info=False;"
    sConn = sConn & "Extended Properties=""DSN=Excel Files;"
    sConn = sConn & "DBQ=" & sPath & "\" & sDB & ".xls;"
    sConn = sConn & "DefaultDir=" & sPath & ";"
    sConn = sConn & "DriverId=790;MaxBufferSize=2048;PageTimeout=5;"""
    
    cnn.Open sConn
    
    Set rst = New ADODB.Recordset
    
    For Each sh In [SheetName]
        
        sSQL = "SELECT A.PN"
        sSQL = sSQL & ", A.RQDATE"
        sSQL = sSQL & ", A.QTY"
        sSQL = sSQL & ", A.COST"
        sSQL = sSQL & ", A.NOMEN"
        sSQL = sSQL & ", A.`GROUP`"
        sSQL = sSQL & ", A.`Late Pieces`"
        sSQL = sSQL & ", A.BackLog "
        
        sSQL = sSQL & "FROM `" & sPath & "\" & sDB & "`.`" & sh.Value & "$` A "
        
        sSQL = sSQL & "WHERE (A.`Late Pieces`>0 OR A.BackLog>0) "
        sSQL = sSQL & "  AND (A.COE='DSC') "
        
        [Sql] = sSQL
        
        With rst
           .Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
           
            With wsData
               lRow = .UsedRange.Rows.Count + 1
               .Cells(lRow, 1).CopyFromRecordset rst
               .Range(.Cells(lRow, .UsedRange.Columns.Count), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Value = sh.Value
            End With
        
           .Close
        End With
    Next
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[ZenRaven]

I've never had to add additional references in my Excel VBA work thus far so I wasn't sure if that was something that had to be done on each computer that used the file. Sounds silly but you never know... that is, until you KNOW .

I will attempt the ADO implementation in my file and post back the results.

Thanks

 

[ZenRaven]

I implemented the ADO solution with late binding so I didn't have to assume the reference version. I've included the sub I wrote below. Here's the unfortunate part [URL unfurl="true"]http://support.microsoft.com/default.aspx?scid=kb;en-us;Q319998[/url]

Sub UpdateFiltered(sSQL As String)
Dim cn As Object, rs As Object
Dim sDB As String, sDir As String, sFile As String, sConn As String
Dim Dest As Worksheet

With ThisWorkbook
  sDir = .Path
  sFile = .Name
End With

Set Dest = Worksheets("Filtered")

sDB = sDir & "\" & sFile

Set cn = CreateObject("ADODB.Connection")

    sConn = "Provider=MSDASQL.1;"
    sConn = sConn & "Persist Security Info=False;"
    sConn = sConn & "Extended Properties=""DSN=Excel Files;"
    sConn = sConn & "DBQ=" & sDB & ";"
    sConn = sConn & "DefaultDir=" & sDir & ";"
    sConn = sConn & "DriverId=790;MaxBufferSize=2048;PageTimeout=5;"""

cn.Open sConn  'Create DB connection
Set rs = CreateObject("ADODB.Recordset")
With rs
    Set .ActiveConnection = cn
    .Source = sSQL 'Pass your SQL
    .Open , , 3, 1
    Dest.UsedRange.Clear
    Dest.Cells(1, 1).CopyFromRecordset rs
    .Close
End With
cn.Close

CLEANUP:
Set Dest = Nothing
Set rs = Nothing
Set cn = Nothing

End Sub

 

[ZenRaven]

Just thought I'd share my final solution on this. It seems that I and many others out there make this process way too complicated. I'm actually somewhat embarrassed that I didn't think of this earlier. There is actually no need to use querytables, ADO, or DAO to do these dependant comboboxes. Autofilter works beautifully to filter a list based on criteria from a previous selection. From that point, all we have to do is copy the filtered list to another sheet and update our named range.

Sub UpdateFiltered(sCriteria As String)
Dim wsFiltered As Worksheet
Dim rCat As Range

Set wsFiltered = Worksheets("Filtered")
Set rCat = Range("Categories")

rCat.AutoFilter field:=2, Criteria1:=sCriteria

With wsFiltered
  .UsedRange.Clear
  rCat.Copy Destination:=.Cells(1, 1)
  .Rows(1).Delete 'kill the header
End With

End Sub

 

[SkipVought]

KISS! ;-)

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}