Excel vba to select next option in autofilter drop down menu

Question

I have several column with a few hundred rows of data. One of my roles is to look through the data (most commonly in column 2), So what I do is click the little drop down arrow on the column header to open the auto filter list, deselects the first value, then select the next value. Then, likewise, open menu, deselect second value and select third.

There's no fixed number of values either. Different data sheets have varying amounts of data. The data usually goes like 0,10,40,50,60,.... Again it isn't fixed. It is an array however. All the data is in increasing order already.

What I need:

1. Preferably a button to click (for column 2) that deselects the currently selected value, selects the next value and filters that out
2. The converse. I.e. Deselects the current value, selects the previous value

Essentially I need a Forward and Back button for my data.

This is what I get when I tried to record my actions.

Sub a()

ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:
    ="750385/000"
    ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:
    ="750385/010"
ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:
    ="750385/017"

End Sub

Appreciate any help!!

Answer 1

There is a method to read out the curent filter, from which on you can loop through the column untill you find that value. here you just need to jump to the value in the next row, which now you can put into the filter.

So in conclusion this method would be your "forward"-button

Sub test()
    Dim startRow As Integer
    startRow = 2
    Dim rangeString As String
    rangeString = "$A$2:$V$609"


    Dim rng As Range
    Set rng = Range(rangeString)

    Dim currentCrit As String
    currentCrit = rng.Parent.AutoFilter.Filters(2).Criteria1
    currentCrit = Right(currentCrit, Len(currentCrit) - 1)

    Dim i As Integer
    For i = startRow To startRow + rng.Rows.Count
        If Cells(i, 2).Value = currentCrit Then
            i = i + 1
            Exit For
        End If
    Next

    If i > rng.Rows.Count + startRow Then
        Exit Sub
    End If

    ActiveSheet.Range(rangeString).AutoFilter Field:=2, Criteria1:=Cells(i, 2).Value
End Sub

Note: This won´t work if there are duplicates in you column B, if this is so replace the part with the For-Loop with the following:

Dim i As Integer
Dim bool As Boolean
bool = False
For i = startRow To startRow + rng.Rows.Count
    If Cells(i, 2).Value = currentCrit Then
        bool = True
    End If

    If bool And Cells(i, 2).Value <> currentCrit Then
        Exit For
    End If
Next

Hope I could help.

Answer 2

I would use Spinbuttons on the sheet and link them to the first cell of the column, it want to filter.

(I called it spbFilterChange and linked it to $B$1)

(picture upload doesnt work here, sorry)

Then you can put the following code in the module of your worksheet:

Private Sub spbFilterChange_SpinDown()
    Change_Filter Me.Range(Me.spbFilterChange.LinkedCell), False
End Sub

Private Sub spbFilterChange_SpinUp()
    Change_Filter Me.Range(Me.spbFilterChange.LinkedCell), True
End Sub

And the following sub in a standard module:

Option Explicit

Sub Change_Filter(SortField As Range, Up As Boolean)
Dim Filter_Values As Collection
Dim Value_Arr, Val, Sort_Value As String
Application.ScreenUpdating = False
    ' Find Unique Values in relevant Column -> Collection
    Set Filter_Values = New Collection
    SortField.Offset(2, 0).Areas(1).AutoFilter SortField.Column
    Value_Arr = SortField.Parent.Range(SortField.Offset(3, 0), SortField.Parent.Cells(SortField.Parent.Rows.Count, SortField.Column).End(xlUp)).Value2
    On Error Resume Next
    For Each Val In Value_Arr
        Filter_Values.Add Val, CStr(Val)
    Next Val

    ' Check if Value of LinkedCell is in range
    If SortField.Value < 1 Or SortField.Value > Filter_Values.Count Then SortField.Value = 1

    ' set autofilter
    Sort_Value = Filter_Values(SortField.Value)
    SortField.Offset(2, 0).AutoFilter SortField.Column, Sort_Value
Application.ScreenUpdating = True
End Sub

This should solve your problem and could be used on different columns and sheets (you have to add another copy of the event-procedures in the worksheet-module).

Answer 3

I would do something like this.

First: Get Help column X where you copy all the Unique data from column B for example.

Option Explicit

Sub CreateUniqueList()
Dim lastrow As Long

lastrow = Cells(Rows.Count, "B").End(xlUp).Row

    ActiveSheet.Range("B1:B" & lastrow).AdvancedFilter _
    Action:=xlFilterCopy, _
    CopyToRange:=ActiveSheet.Range("X1"), _
    Unique:=True
    ActiveSheet.Range("Y1").Value = "x" 
End Sub

Your list could lokk after that like this:

After that, you would need a loop for the buttons:

Something like this.

//The Code is not Testet//

    Sub butNextValue()
Dim lastrow As Long

lastrow = Cells(Rows.Count, "B").End(xlUp).Row


For i = 2 To lastrow
    If ActiveSheet.Cells(i, 25).Value = "x" Then
        If Not ActiveSheet.Cells(i+1, 24)-value = "" Then 'check if next value is there
            ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:=ActiveSheet.Cells(i+1, 24)-value
        Else
            MsgBox "No more Next Values"
        End If
        Exit For
    End If
Next i

End Sub

Sub butPriValue()
Dim lastrow As Long

lastrow = Cells(Rows.Count, "B").End(xlUp).Row


For i = 2 To lastrow
    If ActiveSheet.Cells(i, 25).Value = "x" Then
        If Not ActiveSheet.Cells(i-1, 24)-value = "Set" OR Not ActiveSheet.Cells(i-1, 24)-value = "" Then 'check if next value is there
            ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:=ActiveSheet.Cells(i-1, 24)
        Else
            MsgBox "No more Pri Values"
        End If
        Exit For
    End If
Next i

End Sub