Excel VBA 根据单元格值过滤表格行

Question

I'm trying to exclude values from a table depending on values.

I've got the following table which has columns with names, customer ID, customer city and total spent:

And I would like to filter out the two following specific values, which are customer ID's.

So that the end table would look like this, notice it no longer has Liam Gallagher or Tom Johnson.

I know how to filter these out manually but I was wondering how I can do it on VBA?

I've scoured the inte.net and I haven't been able to find any solutions. Also the two tables will have different arrays as the list of customers can change as well as the customer IDs, so if it's possible to make it dynamic that would be great.

Thanks

Answer 1

Sub advanced_filter()
    Dim rgData As Range, rgCriteria As Range, rgOutput As Range
    
    With ThisWorkbook.Worksheets("Sheet 1")
        Set rgData = .Range("A1").CurrentRegion
        Set rgCriteria = .Range("F1").CurrentRegion
        Set rgOutput = .Range("I1")
    
        .Range("I1:L7").ClearContents
    End With
    rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgOutput

End Sub

UPDATE:
Is there anyway that the customerID's in column F and G
can be stacked vertically instead of horizontally?

You can do this "manually" with vba;-)

Sub advanced_filter()
    Dim rgData As Range, rgCriteria As Range, rgOutput As Range
    
    With ThisWorkbook.Worksheets("Sheet 1")
        Set rgData = .Range("A1").CurrentRegion
        Call CopyTranspose
        Set rgCriteria = .Range("A10").CurrentRegion
        Set rgOutput = .Range("H1")
    
        .Range("H1:L7").ClearContents
    End With
    rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgOutput

End Sub

Sub CopyTranspose()
'
' CopyTranspose Macro
'
    Range("A10:A15").EntireRow.ClearContents

    Dim lineCount As Integer
    lineCount = Range("F1").CurrentRegion.Count
    
    'Transpose Copy
    transposeAndPasteCol Range("F1").CurrentRegion, Range("A11")
    
    Set LastCellRange = Range("B10").Offset(0, lineCount - 2)
    Range("F1").Copy Range(Range("B10"), LastCellRange)

    Range("A10:A20").Delete Shift:=xlToLeft
End Sub

Sub transposeAndPasteCol(ColToCopy As Range, pasteRowTarget As Range)
    pasteRowTarget.Resize(, ColToCopy.Rows.Count) = Application.WorksheetFunction.Transpose(ColToCopy.Value)
End Sub

UPDATE 2:

Sub advanced_filter_V4()
    Dim rgData As Range, rgCriteria As Range, rgOutput As Range
    
    With ThisWorkbook.Worksheets("Sheet 1")
        Set rgData = .Range("A1").CurrentRegion
        Call CopyTranspose
        Set rgCriteria = .Range("A15").CurrentRegion
        Set rgOutput = .Range("F1")
    
        .Range("F1:L7").ClearContents
    End With
    rgData.AdvancedFilter xlFilterCopy, rgCriteria, rgOutput

End Sub

Sub CopyTranspose()
    Range("A15:A20").EntireRow.ClearContents
    transposeAndPasteCol Range("A10:B14"), Range("A15")
End Sub

Sub transposeAndPasteCol(ColToCopy As Range, pasteRowTarget As Range)
    pasteRowTarget.Resize(ColToCopy.Columns.Count, ColToCopy.Rows.Count) _
     = Application.WorksheetFunction.Transpose(ColToCopy.Value)
End Sub