Get AutoFilter sort criteria and apply on second sheet

Question

I\'m trying to see if I can programatically trap an AutoFilter sort event, get the sort criteria and then apply that same sort criteria to an AutoFilter in a second workshee

Answer 1

Here is a way to get the autofilter criteria:

Sub test()
Dim Header As Range
Dim sMainCrit As String, sANDCrit As String, sORCrit As String
Set Header = Range("A2:C2")
    With Header.Parent.AutoFilter
        With .Filters(Header.Column - .Range.Column + 1)
            If Not .On Then
                MsgBox ("no criteria")
                Exit Sub
            End If
            sMainCrit = .Criteria1
            If .Operator = xlAnd Then
                sANDCrit = .Criteria2
            ElseIf .Operator = xlOr Then
                sORCrit = .Criteria2
            End If
        End With
    End With
    MsgBox ("Main criteria: " & sMainCrit & Chr(13) & "AND Criteria:" & sANDCrit & Chr(13) & "OR Criteria" & sORCrit)
End Sub

Adapted from ozgrid

Answer 2

Here are some notes on what I see as your requirements.

Dim rv As AutoFilter ''Object
Set rv = Sheet1.AutoFilter

''Just for curiosity
Debug.Print rv.Sort.Header
Debug.Print rv.Sort.SortFields.Count
Debug.Print rv.Sort.SortFields.Item(1).SortOn
Debug.Print rv.Sort.Rng.Address
Debug.Print rv.Sort.SortFields.Item(1).Key.Address

''One key only, but it is easy enough to loop and add others
Sheet2.Range(rv.Sort.Rng.Address).Sort _
    key1:=Sheet2.Columns(rv.Sort.SortFields(1).Key.Column), _
    Header:=xlYes

Answer 3

Found this code:

Sub ShowAutoFilterCriteria()
' John Green et. al: Excel 2000 VBA Programmer?s Reference, S. 379f
' 09.01.2005
Dim oAF As AutoFilter
Dim oFlt As Filter
Dim sField As String
Dim sCrit1 As String
Dim sCrit2 As String
Dim sMsg As String
Dim i As Integer

' Check if the sheet is filtered at all
If ActiveSheet.AutoFilterMode = False Then
MsgBox "The sheet does not have an Autofilter"
Exit Sub
End If

' Get the sheet?s Autofilter object
Set oAF = ActiveSheet.AutoFilter

' Loop through the Filters of the Autofilter
For i = 1 To oAF.Filters.Count

' Get the field name form the first row
' of the Autofilter range
sField = oAF.Range.Cells(1, i).Value

' Get the Filter object
Set oFlt = oAF.Filters(i)

' If it is on...
If oFlt.On Then

' Get the standard filter criteria
sMsg = sMsg & vbCrLf & sField & oFlt.Criteria1

' If it?s a special filter, show it
Select Case oFlt.Operator
Case xlAnd
sMsg = sMsg & " And " & sField & oFlt.Criteria2
Case xlOr
sMsg = sMsg & " Or " & sField & oFlt.Criteria2
Case xlBottom10Items
sMsg = sMsg & " (bottom 10 items)"
Case xlBottom10Percent
sMsg = sMsg & " (bottom 10%)"
Case xlTop10Items
sMsg = sMsg & " (top 10 items)"
Case xlTop10Percent
sMsg = sMsg & " (top 10%)"
End Select
End If
Next i

If msg = "" Then
' No filters are applied, so say so
sMsg = "The range " & oAF.Range.Address & " is not filtered."
Else
' Filters are applied, so show them
sMsg = "The range " & oAF.Range.Address & " is filtered by:" & sMsg
End If

' Display the message
MsgBox sMsg
End Sub

Works fine on my tests! I've changed a small part of it to support complex criteria:

' Get the standard filter criteria
If IsArray(oFlt.Criteria1) Then
    Dim x As Integer
    sMsg = sMsg & vbCrLf & sField
    For x = 1 To UBound(oFlt.Criteria1)
        sMsg = sMsg & "'" & oFlt.Criteria1(x) & "'"
    Next x
Else
    sMsg = sMsg & vbCrLf & sField & "'" & oFlt.Criteria1 & "'"
End If

Original link: http://www.vbaexpress.com/forum/archive/index.php/t-7564.html