Creating multiple pivot tables using Excel VBA - each pivot table filtered with a distinct value

I have done some searching and can't find any posts with similar issue. I want to create 3 pivot tables on a new sheet, with each table filtered by column B as shown below. The number of items in column B may increase/decrease. I need the macro to loop through all the different combinations of items and apply this filter to each pivot table created.

I have very limited experience with loops in VBA so don't even know where to start.

I have attached screenshots below of the required solution + the code VBA generates for creating a pivot table from a sample table I've created.

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+a
'
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$C$5"), , xlYes).Name = _
        "Table1"
    Range("Table1[#All]").Select
    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight1"
    Application.CutCopyMode = False
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Table1", Version:=7).CreatePivotTable TableDestination:="Sheet2!R3C1", _
        TableName:="PivotTable1", DefaultVersion:=7
    Sheets("Sheet2").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Category")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Traffic"), "Sum of Traffic", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "Assign a unique number to a value")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "Assign a unique number to a value").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "Assign a unique number to a value").CurrentPage = "1"
End Sub 

Also enclosing the sample data screenshot. Thanks in advance guys!

EDIT: Pictures didn't upload so trying to upload again now. macro_test_data

macro_test_pivot_table