Vba to Auto filter based on multiple columns

Question

I'm working on a project and I need your help

I need Vba code to Auto filter and count items based on multiple columns

For example I have

So the result should be

And so on for all the range

I tried Auto filter then select case code for the filltered data And worked but only for another view not the one I'm looking for And the resulted from select case was as below

Appreciate your support please to get the filtered data as this mode

This looks more like a pivot table than anything I'd describe as a filter ... — Steve Lovell, Feb 12 '21 at 15:03
At the last row from the result you expected, what did you mean that the item status is available, flag used, but count zero ? And how did you get four DG8045 flag used where all supplier are Huawei while in your data, there are one used DG8045 from Huawei supplier and three used DG8045 from TP-link supplier ? — karma, Feb 13 '21 at 07:13
And at the second row of your result, how did you get two DG8045 flag new from Huawei while in your data, there are NONE DG8045 flag new from Huawei supplier? (in your data, there only used DG8045 from Huawei supplier) — karma, Feb 13 '21 at 08:27

karma · Accepted Answer · 2021-02-13T18:12:23.337

Since your expected result is confusing (if compare with the data in your picture), I an not so sure what kind of result that you expected.

Anyway, below is a lazy code which create a pivot table based on the data which looks like the one in your picture. After that, it's just a copy paste process.

It assumes that your data is in sheet1,
starts from cell A1 with six column header (cell A1 to F1),
and there's nothing at all to the left after column F.

Sub test()
Set sh = Sheets("Sheet1")
Set shResult = Sheets("Sheet2")
sh.Range("G:Z").Delete

With sh
Range("C1").Value = "BLANK"
Set rg = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
rg.Offset(0, 6).Value = 1
rg.Resize(rg.Rows.Count, 7).Name = "data"
End With

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "data", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:=sh.Range("P1"), TableName:="ptTmp", DefaultVersion _
        :=xlPivotTableVersion14
        
    With sh.PivotTables("ptTmp").PivotFields("SKU Name")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("Supplier")
        .Orientation = xlRowField
        .Position = 2
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("Inventory Item Status")
        .Orientation = xlRowField
        .Position = 3
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("Flag")
        .Orientation = xlRowField
        .Position = 4
        .Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    
    With sh.PivotTables("ptTmp").PivotFields("FLAG")
        .PivotItems("Used").Visible = False
        .PivotItems("Bad").Visible = False
    End With
    
    With sh.PivotTables("ptTmp")
    .AddDataField ActiveSheet.PivotTables("ptTmp"). _
        PivotFields("1"), "COUNT", xlCount
    .RowAxisLayout xlTabularRow
    .RepeatAllLabels xlRepeatLabels
    .ColumnGrand = False
    .ShowTableStyleRowHeaders = False
    .TableRange1.Copy
    End With

    shResult.Range("A1").PasteSpecial Paste:=xlPasteValues
    shResult.Range("A1").PasteSpecial Paste:=xlPasteFormats
    
        With sh.PivotTables("ptTmp")
            With .PivotFields("FLAG")
            .ClearAllFilters
            .PivotItems("New").Visible = False
            .PivotItems("Bad").Visible = False
            End With
            With .PivotFields("SKU Name")
            Range(.DataRange, .DataRange.Offset(0, 4)).Copy
            End With
        End With
    
    shResult.Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
    
        With sh.PivotTables("ptTmp")
            With .PivotFields("FLAG")
            .ClearAllFilters
            .PivotItems("New").Visible = False
            .PivotItems("Used").Visible = False
            End With
            With .PivotFields("SKU Name")
            Range(.DataRange, .DataRange.Offset(0, 4)).Copy
            End With
        End With

    shResult.Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial Paste:=xlPasteValues
    
    sh.Range("G:Z").Delete
    shResult.Activate
    shResult.Range("A1").Select
End Sub

Dear Karma, Thank you so much for help as it is exactly what i need, Really i appreciate your support, But i have another 2 questions Please 1. how to copy the result to another sheet of the same workbook 2. if i need to add extra flag type for ex: bad i tried to add With sh.PivotTables("ptTmp").PivotFields("FLAG") .PivotItems("Bad").Visible = False End With but the view i got was like https://ibb.co/TgN5WQ0 in which i need it to be like this https://ibb.co/0KyXXnH — Mostafa Nabil, Feb 13 '21 at 17:57
@MostafaNabil, please have a look to the code. I've modified so the result will put in Sheet2. (please make sure that your workbook has tab Sheet2). — karma, Feb 13 '21 at 18:00
Once again, Thank you so much! no words can describe how i'm grateful and thankful for your support, yeah it worked The only problem that i face no is when i created button on another sheet on the same workbook to call this function, it does not work untill opening and activate the source sheet itself ! — Mostafa Nabil, Feb 13 '21 at 20:04
@MostafaNabil, Glad that I can help. I am sorry as I made a mistake one line at the code. Please change `AddDataField ActiveSheet.PivotTables("ptTmp")` line into `AddDataField sh.PivotTables("ptTmp")`. Now you can have the button to call the macro on Sheet2. Don't forget to put the code in regular module, not in a sheet module. — karma, Feb 14 '21 at 02:34

Vba to Auto filter based on multiple columns

1 Answers1