CODEWITHSUNDEEP
excelvba
Nikolai
Nikolai

Reputation: 11

Skip blanks cells in a dynamic AdvancedFilter CriteriaRange

How do I skip/ignore blank cells in my CriteriaRange (AdvancedFilter)?

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 found an option to sort the Campaign sheet (Colum B) if it is a table area.

I tried the ActiveSheet.ListObjects function ("Table1"). ListColumns (2) .DataBodyRange.Select, but it's still copying the whole dataset from ProductPriceExport file.

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

Upvotes: 1

Views: 223

Answers (2)

VBasic2008
VBasic2008

Reputation: 54777

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

Upvotes: 1

CGDPaul
CGDPaul

Reputation: 26

You can try this :

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

I have not tested it

Upvotes: 0

Related Questions