Filter Criteria VBA one by one

The below code will copy column B to column P, remove duplicate dates, and then loop through each unique date in column P in column B. Get data for each criteria item in a filter one by one by looping and then copying and pasting the visible cells. Visible cell selection excludes the items that are not included in the excel filter.

---

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 L3 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 L3 is blank and there is only one item in column L to filter '(Annoying variable is set to 2 if multiple and 1 if single item to 'avoid an error message if the other 'scenario happens
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

---

Here's an image of the same code as above in case you want to copy it that way.

---