excelvbaautofilterselect-case

Vba to Auto filter based on multiple columns


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

enter image description here

So the result should be

enter image description here

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

enter image description here

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

enter image description here


Solution

  • 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
    

    enter image description here