Sebzap
asked on
Appling the next criteria in an AutoFilter
Hi,
I have a table with 2 columns. an filter has been set for the 2nd column. Now I need a script that applies "the next available filter" to column 1. Don't know how to explain - please see the attachment: what I need is a script that does the following: set the filter criteria for Column1 to "=4". And the other way - a script that sets the criteria for Column1 to "=1".
Thanks in advance for any ideas!
Regards Sebastian
example.xls
I have a table with 2 columns. an filter has been set for the 2nd column. Now I need a script that applies "the next available filter" to column 1. Don't know how to explain - please see the attachment: what I need is a script that does the following: set the filter criteria for Column1 to "=4". And the other way - a script that sets the criteria for Column1 to "=1".
Thanks in advance for any ideas!
Regards Sebastian
example.xls
ASKER
Thanks for the comment, I know, but I want to iterate through the criterias in filter 1. The script should always go to the next available filter criteria.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks so far. That gives me all the unique values in a column.
But what I need as the first step is more a list/an array of values that are shown when I click the button of a filter, e.g. have a look at the image --> I would need an array which contains c1, c2, c3, C4, c5, s2, s3, s4, S5, s6
Regards Sebastian
090245693083574.JPG
But what I need as the first step is more a list/an array of values that are shown when I click the button of a filter, e.g. have a look at the image --> I would need an array which contains c1, c2, c3, C4, c5, s2, s3, s4, S5, s6
Regards Sebastian
090245693083574.JPG
ASKER
What I want seems to be not possible according to https://www.experts-exchange.com/questions/24777125/VBA-Excel-Loop-through-a-filter.html
ASKER
I managed to solve the problem - ugly, but works.
Thanks for helping!
Regards Sebastian
Thanks for helping!
Regards Sebastian
Private Sub CommandButton2_Click()
NextFilter
End Sub
Private Sub CommandButton3_Click()
PrevFilter
End Sub
Function maximum(arr)
maxi = 0
For Each wert In arr
If wert <> "" Then
If CInt(wert) > maxi Then
maxi = wert
End If
End If
Next wert
maximum = maxi
End Function
Function aktFilter()
If Not AutoFilter.Filters(1).On Then
aktFilter = 0
Exit Function
End If
aktFilter = Replace(AutoFilter.Filters(1).Criteria1, "=", "")
End Function
Function NextFilter()
Application.ScreenUpdating = False
werte = GetUniqueEntries(Range("A2:A65536"))
akt = aktFilter()
If akt = 0 Then
ActiveSheet.Range("A2:A65536").AutoFilter Field:="1", Criteria1:=maximum(werte)
Else
activated = False
For Each k In werte
If activated Then
ActiveSheet.Range("A2:A65536").AutoFilter Field:="1", Criteria1:=k
If anzahlAktiveFilter() > 0 Then
Exit Function
End If
End If
If k = akt Then
activated = True
End If
Next k
End If
End Function
Function PrevFilter()
Application.ScreenUpdating = False
werte = GetUniqueEntries(Range("A2:A65536"))
akt = aktFilter()
If akt = 0 Then
ActiveSheet.Range("A2:A65536").AutoFilter Field:="1", Criteria1:=1
Else
activated = False
For k = UBound(werte) To LBound(werte) Step -1
If activated Then
ActiveSheet.Range("A2:A65536").AutoFilter Field:="1", Criteria1:=werte(k)
If anzahlAktiveFilter() > 0 Then
Exit Function
End If
End If
If werte(k) = akt Then
activated = True
End If
Next k
End If
End Function
Function GetUniqueEntries(ByVal TheRange As Range) As String()
Dim TempArr() As String, TempCt As Long, CLL As Range, i As Long
Set TheRange = Intersect(TheRange, TheRange.Parent.UsedRange)
TempCt = 0
For Each CLL In TheRange.Cells
For i = 0 To TempCt - 1
If TempArr(i) = CLL.Text Then Exit For
Next 'i
If i = TempCt Then
ReDim Preserve TempArr(TempCt)
TempArr(TempCt) = CLL.Text
TempCt = TempCt + 1
End If
Next 'CLL
GetUniqueEntries = TempArr
End Function
Function anzahlAktiveFilter()
Dim Bereich As Range
Dim i As Integer
Set Bereich = Range("A1").CurrentRegion
anzahlAktiveFilter = Intersect(Bereich.SpecialCells(xlVisible), Bereich.Columns(1)).Count - 1
End Function
Saurabh...
Open in new window