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.
Download the sample file (19366 bytes)
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