Excel vba to select next option in autofilter drop down menu

[gberg]

I have a table that I want to cycle through the items in one of the columns using the autofilter. There are thousands of rows and hundreds of items to filter by so I was hoping to have a macro to cycle though each unique item in Column B of my table.


Here is an example of the data in Column B that I would want to filter by one by one with a macro

8I3096

8I3097

8I3097

8I3097

8I3098

8I3098

8I3099

8I3100

8I3100

8I3101

8I3102

8I3103

 

[John_w]

Try this:

Public Sub Loop_AutoFilter_Values()
    
    Dim colBuniques As Variant, colBunique As Variant
    
    With ActiveSheet
        colBuniques = WorksheetFunction.Unique(.Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row))
        For Each colBunique In colBuniques
            .Cells.AutoFilter Field:=2, Criteria1:=colBunique
            MsgBox colBunique
        Next
        .Cells.AutoFilter
    End With
    
End Sub

 

[gberg]

Is there a way to stop the macro between values? I need to make adjustments to the info in other columns. I would like to create a button to run the macro so I could make adjustments to the current selection then press the button to go to the next value.

 

[John_w]

#If VBA7 Then
    Private Declare PtrSafe Function MessageBox Lib "User32" Alias "MessageBoxA" (ByVal hWnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#Else
    Private Declare PtrSafe Function MessageBox Lib "User32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
#End If

Public Sub Loop_AutoFilter_Values()
    
    Dim colBuniques As Variant, colBunique As Variant
    Dim response As Variant
    
    With ActiveSheet
        colBuniques = WorksheetFunction.Unique(.Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row))
        For Each colBunique In colBuniques
            .Cells.AutoFilter Field:=2, Criteria1:=colBunique
            response = MessageBox(0, "Click OK for next column B value, or Cancel to quit", colBunique, vbOKCancel + vbSystemModal)
            If response = vbCancel Then Exit For
        Next
        .Cells.AutoFilter
    End With
    
End Sub

The modeless MessageBox pauses the macro and allows you to access any cell in the workbook.

 

[gberg]

It does allow to access any cell but it does not allow for any editing/changes.

 

[John_w]

You're correct, it doesn't allow editing. For that, a modeless userform can be used and the looping through the colBuniques array is controlled by 2 command buttons on the form.

Add a new userform (UserForm1) with 2 command buttons on it, named cmdOK and cmdCancel.

UserForm1 code:

Option Explicit

Public colBuniques As Variant
Public colBindex As Long

Private Sub UserForm_Initialize()
    With ActiveSheet
        colBuniques = WorksheetFunction.Unique(.Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row))
    End With
    colBindex = 0
End Sub

Private Sub cmdOK_Click()
    With ActiveSheet
        colBindex = colBindex + 1
        If colBindex <= UBound(colBuniques) Then
            .Cells.AutoFilter Field:=2, Criteria1:=colBuniques(colBindex, 1)
        Else
            Unload Me
            .Cells.AutoFilter
        End If
    End With
End Sub

Private Sub cmdCancel_Click()
    Unload Me
    ActiveSheet.Cells.AutoFilter
End Sub

Display UserForm1 modelessly using the following code in a standard module:

Public Sub Show_Form()
    Dim form As UserForm1
    Set form = New UserForm1
    form.Show vbModeless
End Sub

 

[gberg]

I've never used the userforms, but I like them now. That works great, thanks for your help!

 

[gberg]

One quick question (I hope). I copied the data to a blank worksheet to test out your solution. The data in the original worksheet was in a table but when I copied the data to my test worksheet it was not in a table. The test worked fine but the original worksheet with the table did not. I got an error "Run-time error '1004': AutoFilter method of Range class failed". When I went into debug it showed the error was here

   If colBindex <= UBound(colBuniques) Then
            .Cells.AutoFilter Field:=2, Criteria[CODE=vba]

1:=colBuniques(colBindex, 1)
Else
[/CODE]

 

[John_w]

The userform code is slightly different with a table.

Option Explicit

Public colBuniques As Variant
Public colBindex As Long
Public table As ListObject

Private Sub UserForm_Initialize()
    Set table = ActiveSheet.ListObjects(1)
    colBuniques = WorksheetFunction.Unique(table.ListColumns(2).DataBodyRange)
    colBindex = 0
End Sub

Private Sub cmdOK_Click()
    table.Parent.Activate
    With table.Range
        colBindex = colBindex + 1
        If colBindex <= UBound(colBuniques) Then
            .AutoFilter Field:=2, Criteria1:=colBuniques(colBindex, 1)
        Else
            .AutoFilter
            Unload Me
        End If
    End With
End Sub

Private Sub cmdCancel_Click()
    table.Parent.Activate
    table.Range.AutoFilter
    Unload Me
End Sub

 

[gberg]

John, I can't thank you enough. This will save me so much time going through the info in the spreadsheet I have.