Determine if filter set on specific column

[jday]

I have Sheet_1 with data filters applied to range A11. I want to write
code that goes across each of these columns to determine if the filter has
been set or not. If a filter HAS been set, I want the code to Copy/Paste the
values in that column to the same cell on Sheet_2. If a filter HAS NOT been
set for that column, I want the corresponding cell on Sheet_2 to show the
word "ALL".

For example, here is how the table on Sheet_2 might look if the user had set
filters for columns A & C, but not B or D:

A1 B1 C1 D1
--- --- ---- ----
Sales ALL Fargo ALL
Mktg

 

[OssieMac]

Hi jday,

Ensure that you back up your workbook before running the following code just
in case it does not do exactly want you want.

I hope I understood your requirements correctly but feel free to get back to
me if it needs alteration.

The code does some testing to ensure that you have Autofilter on and that
you have at least one filter set otherwise the the code can error out if a
user forgets to do these things first.

Sub Filter_Test()

Dim i As Integer

With Worksheets("Sheet_1")
'Test if AutoFilter is turned on
If .AutoFilterMode Then

'Test if one or more filters is applied
If .FilterMode Then

For i = 1 To 4
With .AutoFilter.Filters(i)
If .On Then
With Sheets("Sheet_1").AutoFilter.Range
.Offset(1, i - 1).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Sheets("Sheet_2").Cells(2, i)
End With
Else
Sheets("Sheet_2").Cells(2, i) = "All"
End If

End With
Next i
Else
MsgBox "No filters actually set"
End If
Else
MsgBox "Autofilter not turned on"
End If
End With

End Sub

 

[jday]

Ossie this solution is almost PERFECT! The only slight issue is when the
copy/paste process is performed, it pastes the format from Sheet_1 which I do
not want on Sheet_2---is there a way to tweak this code so it only pastes the
"values"?

 

[OssieMac]

Hi jayday,

Just replace the copy and paste section with the following

.Offset(1, i - 1).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet_2").Cells(2, i).PasteSpecial _
Paste:=xlPasteValues


Note that it actually becomes 2 lines of code now. The previous code was
effectively one line of code although broken with code line breaks. (there is
no space and underscore after copy in the new code.)