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, 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