Get Date Autofilter in Excel VBA

Question

I am trying to extract Autofilter parameters using VBA. Can any one help me with getting the Autofilter parameters, specifically when a date Autofilter is applied? E.g. Say you have a table with two columns, one contains text data, and a second contains date data.
To set text filter to the first colum:

Range.Autofilter Field:=1, Criteria1=Array("text1","text2","text3","text4"), Operator:=xlFilterValues

Then to get the filter information you can loop through the Criteria1 Variant Array (indexed from 1) to get each filter, as in for i = 1 to 4:

Print Range.Autofilter.Filters(1).Criteria1(i)

Now for column two say a date filter has been set:

Range.AutoFilter Field:=2, Operator:=xlFilterValues, Criteria2:=Array(2, "8/10/2015", 2, "8/20/2015")

If we follow the same logic for the text filter, I'd expect we could get the filter information from a variant array in the Criteria2 property, but this statement will produce an error (1004: Application-defined or object-defined error), whereas you'd expect the integer '2' to be the output:

Print Range.Autofilter.Filters(2).Criteria2(1)

Wingo

Answer 1

I've gone with a rather long-winded approach, but it seems the only way I can find to do it.
Get filter info by extract xml data from xlsx file, store that somewhere, later on the same filter can then be applied by converting the xml into the VBA AutoFilter function. Working code as follows:
Extract autofilter as an xml string. The functions input is a table, but could be modified to take a Range:

Function TableFilterToString(tbl As ListObject) As String
Dim tmpStr As String, f As Filter, i As Long, fi As Long
Dim hasFilterOn As Boolean, tableFilterOn As Boolean

'bleh - cannot extract date filters from VBA (Criteria2 array). Save filters from XML instead, and interpret on implementation

'XlAutoFilterOperator Enumeration (Excel)
'https://msdn.microsoft.com/en-us/library/office/ff839625.aspx

'info on date autofilters:
'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/autofilter-criteria-with-xlfiltervalues-and-dates/90da7c5a-c813-4182-9849-c57ab72dac63?auth=1

tmpStr = ""
fi = 1
Err.Number = 0
On Error Resume Next
tableFilterOn = tbl.AutoFilter.FilterMode
On Error GoTo 0

If tableFilterOn Then
    For fi = 1 To tbl.AutoFilter.Filters.Count
        Set f = tbl.AutoFilter.Filters(fi)
        If f.On Then
            hasFilterOn = True
            Exit For
        End If
    Next

    If hasFilterOn Then
        Dim fn As Variant, xmlFn As Variant, zippedFn As Variant, workingFolder As Variant, thisGUID As String
        thisGUID = "GUID"
        workingFolder = Environ("temp")
        fn = workingFolder & "\" & thisGUID & ".xlsx.zip"
        xmlFn = "table1.xml"
        zippedFn = "xl\tables\" & xmlFn

        'save to temp as xlsx
        'Application.Visible = False
        Err = 0
        On Error Resume Next

        ThisWorkbook.Sheets(Array( _
            tbl.Range.Worksheet.Name _
            )).Copy
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs fn, xlOpenXMLWorkbook
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
        'Application.Visible = True

        If Err.Number <> 0 Then
            MsgBox ("Error getting filter settings")
            Exit Function
        End If
        On Error GoTo 0

        'extract table1.xml
        'https://mcmap.net/q/456271/-how-to-open-a-file-from-an-archive-in-vba-without-unzipping-the-archive
        'http://www.rondebruin.nl/win/s7/win002.htm
        Dim intOptions As Variant, objShell As Object, objSource As Object, objTarget As Object
        Dim ns As Object

        Set objShell = CreateObject("Shell.Application")
        Set ns = objShell.Namespace(fn)
        ' Create a reference to the files and folders in the ZIP file
        Set objSource = ns.Items.Item(zippedFn)
        ' Create a reference to the target folder
        Set objTarget = objShell.Namespace(workingFolder)
        ' UnZIP the files
        'options ref: https://msdn.microsoft.com/en-us/library/windows/desktop/bb787866(v=vs.85).aspx
        intOptions = 16
        objTarget.CopyHere objSource, intOptions
        ' Release the objects
        Set objSource = Nothing
        Set objTarget = Nothing
        Set objShell = Nothing


        'extract filter info
        Dim xmlData As String
        Open workingFolder & "\" & xmlFn For Binary Access Read As 1
            xmlData = Space(LOF(1))
            Get 1, 1, xmlData
        Close 1

        Dim endTag As Long, startTag As Long
        startTag = InStr(1, xmlData, "<autoFilter")
        If startTag > 0 Then
            xmlData = Right(xmlData, Len(xmlData) - startTag + 1)
            endTag = InStr(1, xmlData, "</autoFilter>")
            xmlData = Left(xmlData, endTag + Len("</autoFilter>") - 1)
        End If

        'delete temp files
        On Error Resume Next
        Kill fn
        Kill workingFolder & "\" & xmlFn
        On Error GoTo 0

        tmpStr = xmlData

        'dont have column names, but I will need this later, so add them in.
        Dim c As Long
        c = 1
        For c = 1 To tbl.AutoFilter.Range.Rows(1).Cells.Count
            tmpStr = Replace(tmpStr, "filterColumn colId=""" & c - 1 & """", "filterColumn colId=""" & c - 1 & """ colName=""" & tbl.HeaderRowRange.Cells(1, c).value & """")
        Next
    End If
End If

TableFilterToString = tmpStr End Function

Then, to later on apply the filter, input the range and xml string into this function. Does not cater to color and icon filtering, but could be expanded if this became a requirement.

Sub ApplyXmlAutoFilter(autoFilterRange As Range, strXML As String)
    'XlAutoFilterOperator Enumeration (Excel)
    'https://msdn.microsoft.com/en-us/library/office/ff839625.aspx

    'info on date autofilters:
    'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/autofilter-criteria-with-xlfiltervalues-and-dates/90da7c5a-c813-4182-9849-c57ab72dac63?auth=1

    'refs on autofilter xml schema
    'http://www.ecma-international.org/publications/standards/Ecma-376.htm
    'autofilters: part1 p.3859
    'also, top of sml.xsd inside the zip download

    'clear existing autofilter
    autoFilterRange.AutoFilter

    If strXML = "" Then
        Exit Sub
    End If

    Dim objXML As Object
    Dim baseNode As Object, filterColNode As Object, filtersNode As Object, filterDetailNode As Object
    Dim matchFound As Variant
    Dim colId As Long, colName As String, filterOperator As Integer, dynamicFilter As Integer
    Dim criteria1Array() As Variant, criteria2Array() As Variant, numCriteria1 As Long, numCriteria2 As Long
    Dim criteriaStr As String

    Set objXML = CreateObject("MSXML.DOMDocument")

    If Not objXML.LoadXML(strXML) Then  'strXML is the string with XML'
        Err.Raise objXML.parseError.ErrorCode, , objXML.parseError.reason
    End If

    'XMLDom ref: https://msdn.microsoft.com/en-us/library/aa468547.aspx

    If objXML.HasChildNodes Then
        For Each baseNode In objXML.ChildNodes
            If baseNode.HasChildNodes Then
                For Each filterColNode In baseNode.ChildNodes
                    colId = CLng(filterColNode.getattribute("colId")) + 1 'xml is 0-indexed, so increase by 1
                    colName = filterColNode.getattribute("colName")
                    'if the name exists in the range, then overwrite the colId with the matching name
                    matchFound = Application.Match(colName, autoFilterRange.Rows(1), 0)
                    If Not IsError(matchFound) Then
                        'only apply filter if same column is found
                        colId = matchFound

                        'reset filter variables
                        numCriteria1 = 0
                        numCriteria2 = 0
                        filterOperator = 0
                        ReDim criteria1Array(999)
                        ReDim criteria2Array(999)
                        criteriaStr = ""
                        dynamicFilter = 0

                        If filterColNode.HasChildNodes Then
                            For Each filtersNode In filterColNode.ChildNodes
                                If filtersNode.getattribute("blank") = "1" Then
                                    criteria1Array(numCriteria1) = "="
                                    numCriteria1 = numCriteria1 + 1
                                End If

                                Select Case filtersNode.nodename
                                    Case "colorFilter"
                                        'will need to extrapolate from original XML grab what dxfId is
'                                        If filterDetailNode.getattribute("cellColor") = "false" Then
'                                            filterOperator = xlFilterCellColor
'                                        Else
'                                            filterOperator = xlFilterFontColor
'                                        End If
'                                        criteria1Array(numCriteria1) = filterDetailNode.getattribute("dxfId")
'                                        numCriteria1 = numCriteria1 + 1
                                    Case "dynamicFilter"
                                        filterOperator = xlFilterDynamic
                                        'val\valISO\maxValIso - seemingly these attributes can be ignored, as the filter is dynamic anyway...
                                        'not sure about null, so only code for known filters
                                        'ref XlDynamicFilterCriteria enumeration: https://msdn.microsoft.com/en-us/library/bb241234(v=office.12).aspx
                                        Select Case filtersNode.getattribute("type")
                                            Case "null"
                                                'dynamicFilter = ???
                                            Case "aboveAverage"
                                                dynamicFilter = xlFilterAboveAverage
                                            Case "belowAverage"
                                                dynamicFilter = xlFilterBelowAverage
                                            Case "tomorrow"
                                                dynamicFilter = xlFilterTomorrow
                                            Case "today"
                                                dynamicFilter = xlFilterToday
                                            Case "yesterday"
                                                dynamicFilter = xlFilterYesterday
                                            Case "nextWeek"
                                                dynamicFilter = xlFilterNextWeek
                                            Case "thisWeek"
                                                dynamicFilter = xlFilterThisWeek
                                            Case "lastWeek"
                                                dynamicFilter = xlFilterLastWeek
                                            Case "nextMonth"
                                                dynamicFilter = xlFilterNextMonth
                                            Case "thisMonth"
                                                dynamicFilter = xlFilterThisMonth
                                            Case "lastMonth"
                                                dynamicFilter = xlFilterLastMonth
                                            Case "nextQuarter"
                                                dynamicFilter = xlFilterNextQuarter
                                            Case "thisQuarter"
                                                dynamicFilter = xlFilterThisQuarter
                                            Case "lastQuarter"
                                                dynamicFilter = xlFilterLastQuarter
                                            Case "nextYear"
                                                dynamicFilter = xlFilterNextYear
                                            Case "thisYear"
                                                dynamicFilter = xlFilterThisYear
                                            Case "lastYear"
                                                dynamicFilter = xlFilterLastYear
                                            Case "yearToDate"
                                                dynamicFilter = xlFilterYearToDate
                                            Case "Q1"
                                                dynamicFilter = xlFilterAllDatesInPeriodQuarter1
                                            Case "Q2"
                                                dynamicFilter = xlFilterAllDatesInPeriodQuarter2
                                            Case "Q3"
                                                dynamicFilter = xlFilterAllDatesInPeriodQuarter3
                                            Case "Q4"
                                                dynamicFilter = xlFilterAllDatesInPeriodQuarter4
                                            Case "M1"
                                                dynamicFilter = xlFilterAllDatesInPeriodJanuary
                                            Case "M2"
                                                dynamicFilter = xlFilterAllDatesInPeriodFebruray
                                            Case "M3"
                                                dynamicFilter = xlFilterAllDatesInPeriodMarch
                                            Case "M4"
                                                dynamicFilter = xlFilterAllDatesInPeriodApril
                                            Case "M5"
                                                dynamicFilter = xlFilterAllDatesInPeriodMay
                                            Case "M6"
                                                dynamicFilter = xlFilterAllDatesInPeriodJune
                                            Case "M7"
                                                dynamicFilter = xlFilterAllDatesInPeriodJuly
                                            Case "M8"
                                                dynamicFilter = xlFilterAllDatesInPeriodAugust
                                            Case "M9"
                                                dynamicFilter = xlFilterAllDatesInPeriodSeptember
                                            Case "M10"
                                                dynamicFilter = xlFilterAllDatesInPeriodOctober
                                            Case "M11"
                                                dynamicFilter = xlFilterAllDatesInPeriodNovember
                                            Case "M12"
                                                dynamicFilter = xlFilterAllDatesInPeriodDecember
                                        End Select

                                        If dynamicFilter > 0 Then
                                            criteria1Array(numCriteria1) = dynamicFilter
                                            numCriteria1 = numCriteria1 + 1
                                        End If
                                    Case Else
                                        For Each filterDetailNode In filtersNode.ChildNodes
                                            Select Case filterDetailNode.nodename
                                                Case "filter"
                                                    'normal filter
                                                    filterOperator = xlFilterValues
                                                    criteria1Array(numCriteria1) = filterDetailNode.getattribute("val")
                                                    numCriteria1 = numCriteria1 + 1

                                                Case "customFilter"
                                                    Select Case filterDetailNode.getattribute("operator")
                                                        Case "equal"
                                                            criteriaStr = "="
                                                        Case "lessThan"
                                                            criteriaStr = "<"
                                                        Case "lessThanOrEqual"
                                                            criteriaStr = "<="
                                                        Case "notEqual"
                                                            criteriaStr = "<>"
                                                        Case "greaterThanOrEqual"
                                                            criteriaStr = ">="
                                                        Case "greaterThan"
                                                            criteriaStr = ">"
                                                        Case Else
                                                            criteriaStr = ""
                                                            filterOperator = xlAnd
                                                    End Select
                                                    criteriaStr = criteriaStr & filterDetailNode.getattribute("val")

                                                    If numCriteria1 = 0 Then
                                                        criteria1Array(numCriteria1) = criteriaStr
                                                        numCriteria1 = numCriteria1 + 1
                                                    Else
                                                        If filterDetailNode.getattribute("and") = "1" Then
                                                            filterOperator = xlAnd
                                                        Else
                                                            filterOperator = xlOr
                                                        End If

                                                        criteria2Array(numCriteria2) = criteriaStr
                                                        numCriteria2 = numCriteria2 + 1
                                                    End If

                                                Case "dateGroupItem"
                                                    'info on date autofilters:
                                                    'http://answers.microsoft.com/en-us/office/forum/office_2007-customize/autofilter-criteria-with-xlfiltervalues-and-dates/90da7c5a-c813-4182-9849-c57ab72dac63?auth=1
                                                    'always apply string in American formats, either m/d/yyyy or m/d/yyyy H:m:s
                                                    filterOperator = xlFilterValues
                                                    Select Case filterDetailNode.getattribute("dateTimeGrouping")
                                                        Case "year"
                                                            criteria2Array(numCriteria2) = 0
                                                            criteria2Array(numCriteria2 + 1) = "1/1/" & filterDetailNode.getattribute("year")
                                                            numCriteria2 = numCriteria2 + 2
                                                        Case "month"
                                                            criteria2Array(numCriteria2) = 1
                                                            criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/1/" & filterDetailNode.getattribute("year")
                                                            numCriteria2 = numCriteria2 + 2
                                                        Case "day"
                                                            criteria2Array(numCriteria2) = 2
                                                            criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year")
                                                            numCriteria2 = numCriteria2 + 2
                                                        Case "hour"
                                                            criteria2Array(numCriteria2) = 3
                                                            criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year") _
                                                                & " " & filterDetailNode.getattribute("hour") & ":0:0"
                                                            numCriteria2 = numCriteria2 + 2
                                                        Case "minute"
                                                            criteria2Array(numCriteria2) = 4
                                                            criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year") _
                                                                & " " & filterDetailNode.getattribute("hour") & ":" & filterDetailNode.getattribute("minute") & ":0"
                                                            numCriteria2 = numCriteria2 + 2
                                                        Case "second"
                                                            criteria2Array(numCriteria2) = 5
                                                            criteria2Array(numCriteria2 + 1) = filterDetailNode.getattribute("month") & "/" & filterDetailNode.getattribute("day") & "/" & filterDetailNode.getattribute("year") _
                                                                & " " & filterDetailNode.getattribute("hour") & ":" & filterDetailNode.getattribute("minute") & ":" & filterDetailNode.getattribute("second")
                                                            numCriteria2 = numCriteria2 + 2
                                                    End Select

                                            End Select
                                        Next 'For Each filterDetailNode In filtersNode.ChildNodes
                                End Select

                                'apply filters
                                If filterOperator = xlAnd Or filterOperator = xlOr Or filterOperator = xlFilterDynamic Then
                                    If numCriteria2 > 0 Then
                                        autoFilterRange.AutoFilter _
                                            Field:=colId, _
                                            Criteria1:=criteria1Array(0), _
                                            Criteria2:=criteria2Array(0), _
                                            Operator:=filterOperator
                                    Else
                                        autoFilterRange.AutoFilter _
                                            Field:=colId, _
                                            Criteria1:=criteria1Array(0), _
                                            Operator:=filterOperator
                                    End If
                                ElseIf numCriteria1 > 0 And numCriteria2 > 0 Then
                                    ReDim Preserve criteria1Array(numCriteria1 - 1)
                                    ReDim Preserve criteria2Array(numCriteria2 - 1)
                                    If filterOperator = 0 Then
                                        autoFilterRange.AutoFilter _
                                            Field:=colId, _
                                            Criteria1:=Array(criteria1Array), _
                                            Criteria2:=Array(criteria2Array)
                                    Else
                                        autoFilterRange.AutoFilter _
                                            Field:=colId, _
                                            Criteria1:=Array(criteria1Array), _
                                            Criteria2:=Array(criteria2Array), _
                                            Operator:=filterOperator
                                    End If
                                ElseIf numCriteria1 > 0 Then
                                    ReDim Preserve criteria1Array(numCriteria1 - 1)
                                    If filterOperator = 0 Then
                                        autoFilterRange.AutoFilter Field:=colId, Criteria1:=Array(criteria1Array)
                                    Else
                                        autoFilterRange.AutoFilter Field:=colId, Criteria1:=Array(criteria1Array), Operator:=filterOperator
                                    End If
                                ElseIf numCriteria2 > 0 Then
                                    ReDim Preserve criteria2Array(numCriteria2 - 1)
                                    If filterOperator = 0 Then
                                        autoFilterRange.AutoFilter Field:=colId, Criteria2:=Array(criteria2Array)
                                    Else
                                        autoFilterRange.AutoFilter Field:=colId, Criteria2:=Array(criteria2Array), Operator:=filterOperator
                                    End If
                                End If

                            Next
                        End If 'filterColNode.HasChildNodes
                    End If 'Not IsError(matchFound)
                Next 'For Each filterColNode In baseNode.ChildNodes
            End If 'baseNode.HasChildNodes
        Next 'For Each baseNode In objXML.ChildNodes
    End If 'objXML.HasChildNodes

End Sub

Ends

Wingo

Answer 2

I think you're original problem is two fold. First, it appears you're using the Criteria2 field without Criteria1. You only use Criteria2 when you want to create compound criteria, which requires both a Criteria1 argument and an XLAutoFilterOperator argument to combine (e.g. xlAnd or xlOr) with the Criteria2 argument. In your example it appears you are not specifying a Criteria1 argument.

Second, IIRC all criteria must be provided as a string - which i believe you're second example would cause a problem with the numbers you're trying to pass.

I'm surprised you don't get an error on the Autofilter line actually.

Try changing your code to:

Range.AutoFilter Field:=2, Criteria1:=Array(cstr(2), "8/10/2015", cstr(2), "8/20/2015"), Operator:=xlFilterValues

Print Range.Autofilter.Filters(2).Criteria1(1)

Phyllida

Thanks @CBRF23. I think if you actually try this in Excel 2010, you'll find it will not filter for the dates (it will attempt string comparison matches). It only works on dates if you use Criteria 2. If you are filtering on a column with both date and text types, the same rules apply, text goes into Criteria1, and dates go into Criteria2. Secondly, the Criteria are Variant types, so does not only require a string. – Wingo

Yeah I know they are variants, but for some reason I thought it always wanted a string. Maybe not; I'll see if I can find any documentation on that. Regardless, I didn't change the way you're passing the dates - you were passing them as strings to begin with ;) Even if I'm wrong, that doesn't negate the fact that you need to provide a Criteria1 to use Criteria2. See the documentation and also I found this KB example. – Phyllida

Okay looks like I may have been wrong about it always wanting strings - I'll edit my answer, but have a look here and also here – Phyllida

Okay so it appears I maybe was not wrong about strings - whatever you pass as the argument I believe gets converted to a string. If you read the documentation it says for both Criteria1 and Criteria2 "the criteria (a string...)". It also says if the Criteria1 is omitted, the argument is all - so I guess you can omit this argument and use Criteria2, but I'm not sure why you would want to ;) – Phyllida

Interesting, the Microsoft documentation is lacking, and in some cases out-right wrong as it omits the need for Criteria2 for dates. You KB article can be ignored as it only applied up until Excel 97. Anyway, despite what the documentation says from your googling, a simple test proves it wrong. For example why then, when recording and running a Macro using date selection it uses Criteria2 without any complaints? Additionally, the links you proved are referring to when using a ">" or\and "<" operator etc, not for when specific date groups are selected in the auto filter. @Phyllida – Wingo

@Wingo - I would take the fact that you are getting unpredictable or unexplainable results as a hint to look at changing how you are specifying date groups ;) The macro-recorder does it's best to transform user actions into code, but it's not perfect and almost never gives you directly usable code. For example - anyone familiar with VBA development is aware that .Select and .Activate are neither required, nor desired, in most situations - yet they are always included by the macro recorder. – Phyllida

They are not unpredictable results, and are 100% reproducible! This code for example, in complete opposite of what you are claiming, will happily set the Autofilter to the required filter exactly as expected and with no complaints, assuming you have a column A with some dates in it: Range("A1:A10").AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(2, "8/10/2015") @Phyllida – Wingo

Again, in complete opposite of what you are claiming, this will not filter correctly for dates: Range("A1:A10").AutoFilter Field:=1, Criteria1:=Array("2", "8/10/2015"), Operator:=xlFilterValues @Phyllida – Wingo

@Wingo - I'll have to do some more experimenting on this, it's not something I have a ton of experience with, just trying to offer suggestions based on the documentation. – Phyllida

Answer 3

This issue occurs when the treeview is used in a filter selector regarding dates.

A working alternative to restore autofilters in this situation is explained in this post.

Replenish