Trying to capture the values being filtered in AutoFilter and reapply in Excel

[soapshack]

I'm trying to capture the values that are currently being Autofiltered by the user so I can re-apply them after I'm done with the code. Basically, if I can capture these four or five main column's values, store them, then I'm good. I would then go thru, filter the spreadsheet for what I need...do my update and reapply the original filter. Does that make sense? Anyone ever done this?

[Guido Geurs]

dear,

I have tried and searched but nothing found.
Is it not simpler to write the filter in VBA instead of using the autofilter ?
Is the filter that You want to use complex ?
With a written filter it is also much easyer to capture the data.

br,

[Guido Geurs]

dear,

This will probably solve your problem.
See attachment

Open a new workbook with:
Range in A1 to .... with randum numbers from 1 to 30
Command with name "ComFilter"
VBA prg.=

=============================================
Dim FILTER_VALUES()

Private Sub Com_Filter_Click()
Call CopyFilter
End Sub

Sub CopyFilter()
Dim FILTERRANGE As Range
Dim RESULTSRANGE As Range
Dim I As Integer
Range("A1").Select
Selection.AutoFilter field:=1, Criteria1:=">11", Operator:=xlAnd, _
Criteria2:="<20"
'§ capture filtered rows
With ActiveSheet
With .AutoFilter.Range
On Error Resume Next
Set RESULTSRANGE = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'§ copy cells
If RESULTSRANGE Is Nothing Then
MsgBox "No data to copy"
Else
Set FILTERRANGE = .AutoFilter.Range
FILTERRANGE.Offset(1, 0).Resize(FILTERRANGE.Rows.Count - 1).Copy _
Destination:=.Range("D1")
End If
'§ reset filter
.ShowAllData
.AutoFilterMode = False
End With
'§ Fill array
Range("D1").Select
ReDim FILTER_VALUES(0)
Do Until ActiveCell.Value = ""
FILTER_VALUES(UBound(FILTER_VALUES)) = ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
ReDim Preserve FILTER_VALUES(UBound(FILTER_VALUES) + 1)
Loop
'§ Clear D
Columns("D").Select
Selection.Clear
'§ Dump array to E1
Range("E1").Select
For I = LBound(FILTER_VALUES) To UBound(FILTER_VALUES)
ActiveCell.Value = FILTER_VALUES(I)
ActiveCell.Offset(1, 0).Activate
Next
End Sub

================================================== =

br, (;o})

[Guido Geurs]

Dear,

This is for more than 1 coll.
See attachment

============================================
Dim FILTER_VALUES() As ARRAYRECORD
Private Type ARRAYRECORD
Numbers As Integer
Strings As String
End Type

Private Sub Com_Filter_Click()
Call CopyFilter
End Sub

Sub CopyFilter()
Dim FILTERRANGE As Range
Dim RESULTSRANGE As Range
Dim I As Integer
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:=">10", Operator:=xlAnd, _
Criteria2:="<20"
Selection.AutoFilter Field:=2, Criteria1:="=*a*"
'§ capture filtered rows
With ActiveSheet
With .AutoFilter.Range
On Error Resume Next
Set RESULTSRANGE = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
'§ copy cells
If RESULTSRANGE Is Nothing Then
MsgBox "No data to copy"
Else
Set FILTERRANGE = .AutoFilter.Range
FILTERRANGE.Offset(1, 0).Resize(FILTERRANGE.Rows.Count - 1).Copy _
Destination:=.Range("D1")
End If
'§ reset filter
.ShowAllData
.AutoFilterMode = False
End With
'§ Fill array
Range("D1").Select
ReDim FILTER_VALUES(0)
Do Until ActiveCell.Value = ""
ReDim Preserve FILTER_VALUES(UBound(FILTER_VALUES) + 1)
FILTER_VALUES(UBound(FILTER_VALUES)).Numbers = ActiveCell.Value
FILTER_VALUES(UBound(FILTER_VALUES)).Strings = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(1, 0).Activate
Loop
'§ Clear D
Columns("D:E").Select
Selection.Clear
'§ Dump array to E1
Range("F1").Select
For I = LBound(FILTER_VALUES) + 1 To UBound(FILTER_VALUES)
ActiveCell.Value = FILTER_VALUES(I).Numbers
ActiveCell.Offset(0, 1).Value = FILTER_VALUES(I).Strings
ActiveCell.Offset(1, 0).Activate
Next
End Sub

==============================================