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_Clic k()
Call CopyFilter
End Sub

Sub CopyFilter()
Dim FILTERRANGE As Range
Dim RESULTSRANGE As Range
Dim I As Integer
Range("A1").Sel ect
Selection.AutoF ilter field:=1, Criteria1:=">11 ", Operator:=xlAnd , _
Criteria2:="<20 "
'§ capture filtered rows
With ActiveSheet
With .AutoFilter.Ran ge
On Error Resume Next
Set RESULTSRANGE = .Offset(1, 0).Resize(.Rows .Count - 1, 1) _
.SpecialCells(x lCellTypeVisibl e)
On Error GoTo 0
End With
'§ copy cells
If RESULTSRANGE Is Nothing Then
MsgBox "No data to copy"
Else
Set FILTERRANGE = .AutoFilter.Ran ge
FILTERRANGE.Off set(1, 0).Resize(FILTE RRANGE.Rows.Cou nt - 1).Copy _
Destination:=.R ange("D1")
End If
'§ reset filter
.ShowAllData
.AutoFilterMode = False
End With
'§ Fill array
Range("D1").Sel ect
ReDim FILTER_VALUES(0 )
Do Until ActiveCell.Valu e = ""
FILTER_VALUES(U Bound(FILTER_VA LUES)) = ActiveCell.Valu e
ActiveCell.Offs et(1, 0).Activate
ReDim Preserve FILTER_VALUES(U Bound(FILTER_VA LUES) + 1)
Loop
'§ Clear D
Columns("D").Se lect
Selection.Clear
'§ Dump array to E1
Range("E1").Sel ect
For I = LBound(FILTER_V ALUES) To UBound(FILTER_V ALUES)
ActiveCell.Valu e = FILTER_VALUES(I )
ActiveCell.Offs et(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_Clic k()
Call CopyFilter
End Sub

Sub CopyFilter()
Dim FILTERRANGE As Range
Dim RESULTSRANGE As Range
Dim I As Integer
Range("A1").Sel ect
Selection.AutoF ilter Field:=1, Criteria1:=">10 ", Operator:=xlAnd , _
Criteria2:="<20 "
Selection.AutoF ilter Field:=2, Criteria1:="=*a *"
'§ capture filtered rows
With ActiveSheet
With .AutoFilter.Ran ge
On Error Resume Next
Set RESULTSRANGE = .Offset(1, 0).Resize(.Rows .Count - 1, 1) _
.SpecialCells(x lCellTypeVisibl e)
On Error GoTo 0
End With
'§ copy cells
If RESULTSRANGE Is Nothing Then
MsgBox "No data to copy"
Else
Set FILTERRANGE = .AutoFilter.Ran ge
FILTERRANGE.Off set(1, 0).Resize(FILTE RRANGE.Rows.Cou nt - 1).Copy _
Destination:=.R ange("D1")
End If
'§ reset filter
.ShowAllData
.AutoFilterMode = False
End With
'§ Fill array
Range("D1").Sel ect
ReDim FILTER_VALUES(0 )
Do Until ActiveCell.Valu e = ""
ReDim Preserve FILTER_VALUES(U Bound(FILTER_VA LUES) + 1)
FILTER_VALUES(U Bound(FILTER_VA LUES)).Numbers = ActiveCell.Valu e
FILTER_VALUES(U Bound(FILTER_VA LUES)).Strings = ActiveCell.Offs et(0, 1).Value
ActiveCell.Offs et(1, 0).Activate
Loop
'§ Clear D
Columns("D:E"). Select
Selection.Clear
'§ Dump array to E1
Range("F1").Sel ect
For I = LBound(FILTER_V ALUES) + 1 To UBound(FILTER_V ALUES)
ActiveCell.Valu e = FILTER_VALUES(I ).Numbers
ActiveCell.Offs et(0, 1).Value = FILTER_VALUES(I ).Strings
ActiveCell.Offs et(1, 0).Activate
Next
End Sub

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