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

Answer 1

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)

Answer 2

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.

Answer 3

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
        'http://stackoverflow.com/questions/19716587/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