DataWright Information Services

Consulting and Resources for Excel and Access




Using ADO to filter data in an Excel workbook

The idea for this example came from a question on
mrexcel.com, a very active
Excel bulletin board.

There are several ways to filter data in Excel. The obvious
options are to use the inbuilt AutoFilter or Advanced Filter. They
work well, but one limitation is that you need to place the filter
results on the same worksheet as the original data. If you need to
extract the data to a different sheet, you need a different
approach. Using ADO, you can build a query that places the filtered
data wherever you want.

The workbook has two sheets: DB_Data has a list of about
160 names, and Data2 has a validation drop-down that lets you select
a letter. Once you make your selection, surnames starting with that
letter are copied to Data2.

The main code

The main code, ADO_Self_Excel, is shown below.

Sub ADO_Self_Excel()
  Dim cnn As ADODB.Connection
  Dim rst As ADODB.Recordset
  Dim sSQL As String
  Dim sPath As String
  Dim MyConn
  Dim sFilter As String

  sPath = ActiveWorkbook.FullName

  'Define the filter and the SQL statement that extracts the names.
  'Use % as the wild card character in ADO, not *

  sFilter = UCase(Sheets("Data2").Range("H1").Value) & "%" 

  sSQL = "SELECT * FROM [DB_Data$]" 'DB_Data is the SOURCE sheet
  sSQL = sSQL & " WHERE LastName Like '" & sFilter & "'"

  'Establish connection to the same file
  'When connecting to Excel instead of a database, you need to define
  'the extended properties as Excel 8.0 (The first Excel version to use ADO)

  MyConn = sPath 

  Set cnn = New ADODB.Connection
  With cnn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .Properties("Extended Properties").Value = "Excel 8.0"
    .Open MyConn
  End With

  'Define a recordset based on the SQL statement

  Set rst = New ADODB.Recordset
  rst.CursorLocation = adUseServer
  rst.Open Source:=sSQL, _
    ActiveConnection:=cnn, _
    CursorType:=adOpenForwardOnly, _
    LockType:=adLockOptimistic, _
    Options:=adCmdText

  Application.ScreenUpdating = False

  'Delete existing data on the destination sheet, then
  'transfer the results of the latest filter, starting at cell A2.
  'When done, clean up references to avoid memory leaks.

  With Sheets("Data2") 'Data2 is the DESTINATION sheet
    .Range("A1").CurrentRegion.Offset(1, 0).Clear
    .Range("A2").CopyFromRecordset rst
  End With
  rst.Close
  cnn.Close

  Application.ScreenUpdating = True

End Sub

The code is triggered using a Worksheet_Change event in the
module attached to the worksheet. To get to this module, right-click
the sheet tab and View > Code. When cell H1 changes, ADO_Self_Excel
builds the filter using the contents of H1. If H1 is blank, all
records are returned.

Private Sub Worksheet_Change(ByVal Target As Range)
  'Stop the code from firing unless the desired cell has changed

  If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Range("H1"), Target) Is Nothing Then Exit Sub

  'Call the main code
  Call ADO_Self_Excel
End Sub