Skip Blanks cells in a dynamic AdvancedFilter CriteriaRange

Question

Hello stackoverflow :)

I can't figure out how to skip/ignore blank cells in my CriteriaRange (AdvancedFilter).

The currently code is:

Sub BrandExtraction ()

Application.CutCopyMode = False

Dim rngCrit As Range
Dim rngData As Range

Set rngData = Sheets("ProductPriceExport").Range("A1").CurrentRegion

 With Sheets("Campaign")
        Set rngCrit = .Range("C1", .Range("C" & Rows.Count).End(xlUp))
    End With

rngData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit, CopyToRange:=Range("A1:AN1"), Unique:=False

I'am a excel newbie, so i would be very happy if someone could help me.. Thanks

Edit:

I have found that it's an option to sort the Campaign sheet (Colum B) if it is a table area. I have tried working this out with the ActiveSheet.ListObjects function ("Table1"). ListColumns (2) .DataBodyRange.Select, but it's still Copying the whole dataset from ProductPriceExport file when running the macro. Maybe you have a workaround for that? @VBasic2008

What I have tried:

Sub PrimaryBrandExtractionTestTable()

Application.CutCopyMode = False

Dim rngCrit As Range
Dim rngData As Range
Dim tbl As ListObject

**Set tbl = ActiveSheet.ListObjects("KampagneTabel")**
Set rngData = Sheets("ProductPriceExport").Range("A1").CurrentRegion

 With Sheets("Campaign")
Set rngCrit = **tbl.ListColumns(2).DataBodyRange.Select**

        
    End With

rngData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit, CopyToRange:=Sheets("BrandExtraction").Range("A1:AN1"), Unique:=False

End Sub

Do i miss something? Thanks in advance :)

Answer 1

Using Advanced Filter (With a Little Help From AutoFilter)

• You should probably do the whole thing by using AutoFilter.
• The second solution uses AutoFilter to remove the copied 'blanks'.

Option Explicit


Sub BrandExtractionBasic()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim rngData As Range
    Set rngData = wb.Worksheets("ProductPriceExport").Range("A1").CurrentRegion

    Dim rngCrit As Range
    With wb.Worksheets("Campaign")
        Set rngCrit = .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
    End With
    
    Dim rngCopy As Range
    With wb.Worksheets("BrandExtraction")
        .UsedRange.Clear
        Set rngCopy = .Range("A1").Resize(, rngData.Columns.Count)
    End With
    
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngCopy
     
End Sub


Sub BrandExtraction()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim rngData As Range
    Set rngData = wb.Worksheets("ProductPriceExport").Range("A1").CurrentRegion

    Dim rngCrit As Range
    With wb.Worksheets("Campaign")
        Set rngCrit = .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
    End With

    With wb.Worksheets("BrandExtraction")
        .UsedRange.Clear
        Dim rngCopy As Range
        Set rngCopy = .Range("A1").Resize(, rngData.Columns.Count)

    
        rngData.AdvancedFilter xlFilterCopy, rngCrit, rngCopy
        
        Set rngCopy = .Range("A1").CurrentRegion ' reusing variable!
        With rngCopy
            Set rngData = .Resize(.Rows.Count - 1).Offset(1) ' reusing variable!
            .AutoFilter 9, "=" ' filter blanks ('9' means 'I' column)
        End With
        
        Dim rngVisible As Range
        On Error Resume Next
            Set rngVisible = rngData.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        .AutoFilterMode = False
        
        If Not rngVisible Is Nothing Then rngVisible.Delete xlShiftUp
    
    End With
     
End Sub

Answer 2

You can try this :

CriteriaRange:=Array(rngCrit, "<>")

I have not tested it