VBA - Loop over items to filter by

Question

There's a column with email addresses. Some are unique, some a repeated. This bit of code will get the unique ones out and paste that list into a specified range.

Sub Filter_Uniques()

Dim uniquesArray()
Dim lastRow As Long

With Sheet1
    Sheets("WORKING").Columns("D:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("E1"), Unique:=True
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    uniquesArray = .Range("E1:E" & lastRow)
End With
End Sub

This is two lines of a recorded macro that filters a column:

Sub Macro1()
    ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=4, Criteria1:= _
        "a@bot.com"
End Sub

What I want is to be able to loop over the unique list and enter those one by one into the criteria (and then do some other code before the next loop iteration).

EDIT: It isn't a duplicate of "Excel macro to copy data from one sheet to another based on specific matching conditions" because I'm not asking how to copy data from one sheet to another.

It isn't a duplicate of "Create a new sheet for each unique agent and move all data to each sheet" because I'm not trying to move data to different sheets.

Nowhere in this question have I asked to move/copy data. Please read the question, and if you don't understand the question, ask for clarification if you're interested in answering.

score 1 · Answer 1 · answered Jul 08 '18 at 11:03

Option 1

Loop over the indices of the Array

Dim n As Long
For n = 1 To uniquesArray
    ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=4, Criteria1:=uniquesArray(n, 1)
    'Do Something
Next

Option 2

Iterate over the elements of the Array

Dim item As Variant
For Each item In uniquesArray
    ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=4, Criteria1:=item
    'Do Something
Next

Option 3

Don't use the Advanced Filter at all. Add the unique values to an ArrayList and then iterate over the items in the ArrayList.

Sub Filter_ListUniques()
    Dim list As Object, item As Variant
    Set list = CreateObject("System.Collections.ArrayList")
    Dim uniquesArray()
    Dim lastRow As Long

    With Sheet1
        For Each item In .Range("D2", .Range("D" & .Rows.Count).End(xlUp))
            If Not list.Contains(item.Value) Then list.Add item.Value
        Next
    End With

    For Each item In list

        ActiveSheet.Range("$A$1:$D$22").AutoFilter Field:=4, Criteria1:=item
        'Do Something
    Next

End Sub

VBA - Loop over items to filter by

1 Answers1

Option 1

Option 2

Option 3