DandelionFinal2

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.

    1. Beyond Excel
    2. 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.

RecordsAllFinal

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.

RecordsFilteredFinal

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:
RecordsetOutFinal

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:
RecordWFieldsFinal

Looks pretty good – I just want to add some formatting to improve readability.

CharlieDanielsFinal

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:

RecordWFieldsAutoFitComplete

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)

Trackback

no comment untill now

Add your comment now