VBA Loop Through All Items in Filter

Filtering in Microsoft Excel 2007, 2013, and 2016 is annoying and time consuming. Nobody wants to hear you clicking 10,000 times a day to select the data that you need from a filtered data set. A quick work around is to use VBA to filter your sheets. In my VBA Filter Lesson, I showed you all the major ways to filter data in Excel.

In the below video, I show you how to loop through all the items in a filter. The below video tutorial teaches you how to use VBA to loop through all the unique cells in a column filter and filter them one by one. This method of filtering will work regardless of how many items are in a filter. There could be 100 different days of data and this code will complete in seconds what would take an ordinary Excel user all day to click through.

If you are watching on mobile, I recommend watching on the youtube app for best quality video. If you are watching on PC, I recommend clicking the gear Icon once starting the video and selecting the highest quality video.

Here is the code that I used in this video:

Sub LoopThroughAllItemsInFilters()

Columns("b").Select
Selection.Copy

Columns("L").Select
ActiveSheet.Paste
ActiveSheet.Range("$L$1:$L$10000").RemoveDuplicates Columns:=1, Header:=xlYes

Dim ArrayDictionaryofItems As Object, Items As Variant, i As Long, Item As Variant

Set ArrayDictionaryofItems = CreateObject("Scripting.Dictionary")

With ActiveSheet

'show autofilter if not already shown on all rows

If Not .AutoFilterMode Then .UsedRange.AutoFilter
If .Cells.AutoFilter Then .Cells.AutoFilter

'Create list of unique items in column B that get filled into ArrayDictionaryofItems
Dim annoying As Double

If Range("B3").Value <> "" Then
annoying = 2
Items = Range(.Range("L2"), .Cells(Rows.Count, "L").End(xlUp))

'Fills ArrayDictionaryofItems to the UBOUND (max) count of unique items in column L. Starts off
'as Items(1,1) and sets the first element in array equal to 1/1/2018
'then Items(2,1) and sets the second element in array equal to 1/2/2018
For i = 1 To UBound(Items, 1)
ArrayDictionaryofItems(Items(i, 1)) = 1
Next

Else

Item = Range("B2").Value
annoying = 1
End If

'Filter multiple items if annoying is set to equal 2 because B3 is blank
If annoying = 2 Then

For i = 1 To UBound(Items, 1)
Sheets.Add After:=Sheets(i)
Next i

Sheets("Sheet1").Select

Dim x As Double
x = 2

For Each Item In ArrayDictionaryofItems.keys
erow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'autofilter on column b with this driver
.UsedRange.AutoFilter field:=2, Criteria1:=Item

Columns("A:B").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Sheets(x).Select
Columns("A:B").Select
ActiveSheet.Paste
Sheets("Sheet1").Select

x = x + 1
Next Item
GoTo LINE99:
End If

'Filter a single item in column since B3 is blank and there is only one item in column B to filter
If annoying = 1 Then

Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Select

Item = Range("B2").Value
.UsedRange.AutoFilter field:=2, Criteria1:=Item
End If

Columns("A:B").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Sheets(2).Select
Columns("A:B").Select
ActiveSheet.Paste
Sheets("Sheet1").Select

End With

LINE99:
With ActiveSheet
If .AutoFilterMode Then .UsedRange.AutoFilter
End With

End sub