Dandelions are weeds. I’ve spent more hours weeding them out of my family’s yard and my grandparents’ yards than I care to count. Yet, when you come across them in a meadow, they are very nice to look at and add a kind of tranquility in their own right. They are edible and make a nice tasting wine. Here’s a recipe from AllRecipes. Let us know how it turns out.
Today’s post, however, is not about dandelions or wine making – it about the Filter Property of ADO Recordsets.
edit: As is my usual practice, I am going to use Late Binding in the sample snippets below. A discussion on Late / Early Binding is beyond the scope of this post. Please see these links for a detailed explanation of Late / Early Binding.
- Beyond Excel
- JP Software Technologies
In my last post on ADO Recordsets, I demonstrated some VBA to load a Worksheet Range into a Recordset – check it out here.
First Step
Before I filter the Recordset, I would like to manually filter the dataset so I can determine what the final results should be so I can compare to make sure everything goes correctly with the Recordset Filter.
Here’s some data I borrowed from Marco Russo and Alberto Ferrari. It looks as though it may have come from the AdventureWorks Database. There are a total of 60,398 records.
Now I’ll filter on the SalesManager field to look at records that are not related to Marco.
OK, 25,109 records remain after I filter out records for Marco so When I filter the Recordset, I should receive 25,109 records. I removed the AutoFilter, now I am ready to Filter the Recordset
Global Constants
In my last post. on ADO Recordsets, I began by adding some Global Constants to a module named “M_Globals”. I’m going to add a few new constants for the Filter Group Enumeration. I may use them, I may not. But at least I have them defined if I do need them.
'Filter Group Enumeration
Public Const gcladFilterNone = 0 'No filter. This value removes the current filter and restores all records to view.
Public Const gcladFilterPendingRecords = 1 'Use the pending records. This value allows viewing only those records that have changed but have not yet been sent to the server. This value is only applicable for batch update mode.
Public Const gcladFilterAffectedRecords = 2 'Use only records affected by the last Delete, Resync, UpdateBatch, or CancelBatch call.
Public Const gcladFilterFetchedRecords = 3 'Use the last fetched records. This value allows viewing the records in the current cache returned as a result of the last call to retrieve records (implying a resynchronization).
Public Const gcladFilterConflictingRecords = 5 'Use the conflicting records. This value allows viewing only those records that failed the last batch update.
Load The Recordset
I won’t clutter this tutorial by reposting the same code I posted in my last article on ADO Recordsets, check the Sub() out here.
Filter The Recordset
Now that I have a Recordset, I just need to add a bit of code to filter it. Recall, I am interested in all records where the Sales Manager is not Marco. So my criteria string will be something like “SalesManager <> ‘Marco Russo'”
I just need to add 6 lines to my original Sub() and of those, 2 lines are comment lines (I could use fewer lines, I’m using additional lines for clarity)
Dim strFilter As String
'Filter string
strFilter = "SalesManager <> 'Marco Russo'"
'Filter the Recordset and display the filter record and field count to check results
rs.Filter = strFilter
Debug.Print "The filtered recordset contains " & Format(rs.RecordCount, "##,##0") & " records and " & rs.Fields.Count & " fields"
Returns:
The original recordset contains 60,398 records and 23 fields
The filtered recordset contains 25,109 records and 23 fields
Perfect! The Filtered Recordset matches with the results I obtained earlier by manually filtering the Range.
Gimmee The Data…
Most likely, we want to return the dataset back to the user in either a new workbook or a new worksheet. For today, I’ll return the Filtered Recordset back to the same Workbook on a new Worksheet.
Add A Worksheet
I’ll create a Function to add a worksheet to a workbook so that I have a safe place to return the results of the Filtered Recordset
Public Function AddWorksheet(wb As Workbook) As Worksheet
'Declare variables
Dim wsNew As Worksheet
'Add worksheet to end of other worksheets in the workbook
With wb
Set wsNew = .Worksheets.Add _
(After:=.Worksheets(.Worksheets.Count))
End With
'Return object to function
Set AddWorksheet = wsNew
'Tidy up
Set wsNew = Nothing
End Function
And I call the Function here:
'Add a worksheet for the filtered results
Set wsResults = AddWorksheet(wb:=wb)
CopyFromRecordset Method
The Range Object has a CopyFromRecordset Method, so I’ll use that:
'Copy the filtered recordset to the results range
'The CopyFromRecordset Method does not include headers
wsResults.Cells(1, 1).CopyFromRecordset rs
And the output:
It’s looking good. The record count matches with what I expected from the manual filter process at the top of the post. The only problem is that the CopyFromRecordset Method does not include the field headers, so I’ll need a small Sub() to get the field headers and then output the Recordset to Cell(2,1) instead of Cell(1,1).
The Fields Collection
The Recordset Object has a Fields Collection, so I can loop through the Fields Collection to get the Field Names. The gotcha here is that the Fields Collection begins as zero – so be aware of that.
Here’s the Sub():
Public Sub GetRSFieldNames(ws As Worksheet, _
rs As Object)
'Declare variables
Dim x As Long
'Get field names
For x = 0 To rs.Fields.Count - 1
ws.Cells(1, x + 1).Value = rs.Fields(x).Name
Next x
End Sub
Here is how I called the Sub():
'Output Recordset Field Names to the worksheet
Call GetRSFieldNames(ws:=wsResults, _
rs:=rs)
And the Output:
Looks pretty good – I just want to add some formatting to improve readability.
Fiddle Factor
No – not Charlie Daniels pictured here sawing on a fiddle and playing it hot as in The Devil Went Down To Georgia. Rather, Fiddle Factor is a term I learned from one of my supervisors which refers to the amount of time and energy spent formatting an Excel Report. The more time and energy spent – the higher the Fiddle Factor.
But I think formatting is very important. Not only does it make data and information easier to read and understand, but if it is done well, it actually draws or invites the reader in. Stephen Few has quite a bit to say about well-done formatting on his blog, Perceptual Edge.
Enough of my soap box, my goal in this case is not so lofty. I just want to add a bit of color to the header row, fit the column width to the data and maybe play with the zoom level:
Here is the Sub() to format the output:
Sub FormatOutput(ws As Worksheet)
'Declare variables
Dim LastColumn As Long
Dim rngHeader As Range
Dim lngColor As Long
'initialize
lngColor = RGB(68, 84, 106)
'Get last column of header row range
LastColumn = GetLast(ws:=ws, _
strType:="c")
'Create Range Object - header row range
With ws
Set rngHeader = .Range(.Cells(1, 1), .Cells(1, LastColumn))
End With
'Format the header row range
With rngHeader
.Interior.Color = lngColor
.Font.Bold = True
.Font.Color = vbWhite
End With
'Format Dates
With ws
.Range("L2").EntireColumn.NumberFormat = "MM/DD/YYYY"
End With
'Set zoom level
ws.Activate
ActiveWindow.Zoom = 75
'Fit column width to data
Columns.AutoFit
End Sub
And here is how I call the Sub():
'Format the output
Call FormatOutput(ws:=wsResults)
The Full Monty
Here is the main Sub() with the additions to Filter the Recordset, Output the Recordset to a new Worksheet, and Format the data:
Sub FilterRecordset()
'Declare variables
Dim wb As Workbook
Dim wbADO As Workbook
Dim ws As Worksheet
Dim wsResults As Worksheet
Dim rng As Range
Dim rngResults As Range
Dim cn As Object
Dim rs As Object
Dim cmd As Object
Dim strWorksheet As String
Dim strSQL As String
Dim strWorkbookADO As String
Dim strFilter As String
'Excel environemnt
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
'Initialize
Set wb = ThisWorkbook
'Get worksheet to be loaded into recordset
strWorksheet = GetSelectedSheet(strPrompt:="Select a cell on the worksheet to be loaded into the recordset", _
strTitle:="Worksheet To Recordset")
'Create a new workbook to hold all data from the selected worksheet
Set wbADO = Workbooks.Add
'Copy everything from the selected worksheet to the new workbook
Call CopyData(wbSource:=wb, _
wbDestination:=wbADO, _
strSource:=strWorksheet)
'Cleanup the destination workbook
Call CleanupWorkbook(wb:=wbADO)
'Save and close the data workbook
With wbADO
.SaveAs wb.Path & "\" & Mid(wb.Name, 1, Len(wb.Name) - 5) & "_ADO.xlsx", FileFormat:=xlOpenXMLWorkbook
strWorkbookADO = wbADO.FullName
.Close
End With
'Create a range object to measure source data against final recordset data
Set ws = wb.Worksheets(strWorksheet)
Set rng = ws.Range("A1").CurrentRegion
'SQL string
strSQL = "SELECT * FROM [Data$]"
'Filter string
strFilter = "SalesManager <> 'Marco Russo'"
'Create ADO Connection Object
Set cn = GetADOConnection()
cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbookADO & ";" & _
"Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1'")
'Create ADO Command Object
Set cmd = GetCommand()
Set cmd.ActiveConnection = cn
cmd.CommandType = gcladCmdText
cmd.CommandText = strSQL 'Pass SQL String to the command object
'Create ADO Recordset Object and load records
Set rs = GetRecordset()
With rs
.CursorLocation = gcladUseClient
.CursorType = gcladOpenDynamic
.LockType = gcladLockOptimistic
.Open cmd
End With
'Compare recordset results to original data
Debug.Print "The original recordset contains " & Format(rs.RecordCount, "##,##0") & " records and " & rs.Fields.Count & " fields"
Debug.Print "The range contains " & Format(rng.Rows.Count - 1, "##,##0") & " rows and " & rng.Columns.Count & " columns" '-1 to discount header row
'Filter the Recordset
rs.Filter = strFilter
'Add a worksheet for the filtered results
Set wsResults = AddWorksheet(wb:=wb)
'Output Recordset Field Names to the worksheet
Call GetRSFieldNames(ws:=wsResults, _
rs:=rs)
'Copy the filtered recordset to the results range
'The CopyFromRecordset Method does not include headers
wsResults.Cells(2, 1).CopyFromRecordset rs
'Format the output
Call FormatOutput(ws:=wsResults)
'Tidy up
'Close objects
rs.Close
cn.Close
'Destroy objects
Set rs = Nothing
Set cmd = Nothing
Set cn = Nothing
Set rng = Nothing
Set ws = Nothing
Set wsResults = Nothing
Set wbADO = Nothing
Set wb = Nothing
'Excel environemnt
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
And the final output:
Tidy up
Final Thoughts
This post was about Filtering ADO Recordsets. The Filter I used was very simple and only scratches the surface of what is possible. You may use the Filters in combinations with AND, OR, LIKE and Wildcard Characters. Make sure you check out the link to Recordset Filter Property. Lots of great information.
I don’t like that I hard coded the Filter String inside the Sub(). It would be better to offer a user form at run-time to read the fields in the recordset and prompt the user to make choices through Combo Boxes, Check Boxes, etc…
Other Recordset Posts At dataprose.org
Additional Resources
Downloads
Download the file from OneDrive. The filename is Excel – Recordset_v3.xlsm
Credits
Data courtesy Microsoft Excel 2013 Building Data Models with PowerPivot by Alberto Ferrari and Marco Russo (Mar 25, 2013)
Filter
