Memorize activated Filters in a excel worksheet

[Martin Rogelio Gomez Toledano]

Can someone tell me how to memorize activated filters in a excel
worksheet inside of a VBA procedure in order to, once executed other
necesary code, recall the filters data again to restore the original
worksheet configuration?
It its necessary doing it so because when the autofilter is active with
some criteria filtering the worksheet, the rest of the code does not
work properly.

Thanks

--
Martín Rogelio Gómez Toledano

[Bill Manville]

In article <3A6C7E9E...@iies.es>, Martin Rogelio Gomez Toledano wrote:
> Can someone tell me how to memorize activated filters in a excel
> worksheet inside of a VBA procedure in order to, once executed other
> necesary code, recall the filters data again to restore the original
> worksheet configuration?
>

Try this:

Option Explicit

Dim SaveArray() As String
Dim bFiltered As Boolean
Dim rFilterRange As Range

Sub SaveFilters()
Dim I As Integer
bFiltered = ActiveSheet.AutoFilterMode
If bFiltered = False Then Exit Sub
With ActiveSheet.AutoFilter
ReDim SaveArray(1 To .Filters.Count)
For I = 1 To .Filters.Count
With .Filters(I)
If .On Then
SaveArray(I) = CStr(.Criteria1) & "~" & .Operator
On Error Resume Next
SaveArray(I) = SaveArray(I) & "~" & _
CStr(.Criteria2)
On Error GoTo 0
Else
SaveArray(I) = ""
End If
End With
Next
Set rFilterRange = .Range
End With
ActiveSheet.AutoFilterMode = False
End Sub

Sub RestoreFilters()
Dim I As Integer
Dim iCh1 As Integer
Dim iCh2 As Integer
Dim iOp As Integer

If bFiltered = False Then Exit Sub
rFilterRange.AutoFilter
For I = 1 To UBound(SaveArray)
If SaveArray(I) <> "" Then
iCh1 = InStr(SaveArray(I), "~")
iCh2 = InStr(iCh1 + 1, SaveArray(I), "~")

If iCh2 = 0 Then
' one criterion
rFilterRange.AutoFilter I, Left(SaveArray(I), iCh1 - 1)
Else
' two criteria
iOp = CInt(Mid(SaveArray(I), iCh1 + 1, iCh2 - iCh1 - 1))
If iOp <> 0 Then
rFilterRange.AutoFilter I, Left(SaveArray(I), iCh1 - 1), _
iOp, Mid(SaveArray(I), iCh2 + 1)
Else
rFilterRange.AutoFilter I, Left(SaveArray(I), iCh1 - 1)
End If
End If
End If
Next
End Sub

Bill Manville
MVP - Microsoft Excel, Oxford, England
No email replies please - reply in newsgroup