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

CodePudding user response：

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

CodePudding user response：

You can try this :

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

I have not tested it