VBA for filtering columns

141,098

Here's a different approach. The heart of it was created by turning on the Macro Recorder and filtering the columns per your specifications. Then there's a bit of code to copy the results. It will run faster than looping through each row and column:

Sub FilterAndCopy()
Dim LastRow As Long

Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
    .Range("$A:$E").AutoFilter
    .Range("$A:$E").AutoFilter field:=1, Criteria1:="#N/A"
    .Range("$A:$E").AutoFilter field:=2, Criteria1:="=String1", Operator:=xlOr, Criteria2:="=string2"
    .Range("$A:$E").AutoFilter field:=3, Criteria1:=">0"
    .Range("$A:$E").AutoFilter field:=5, Criteria1:="Number"
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub

As a side note, your code has more loops and counter variables than necessary. You wouldn't need to loop through the columns, just through the rows. You'd then check the various cells of interest in that row, much like you did.

Share:
141,098
Ampi Severe
Author by

Ampi Severe

Updated on August 31, 2020

Comments

  • Ampi Severe
    Ampi Severe over 3 years

    I have a big database-like sheet, first row contains headers. I would like a subset of rows of this table based on column values. Two issues:

    1) VBA-wise I would like to loop through the columns, when the values for all necessary columns all match, copy the entire row into a new sheet.

    2) The subset of rows is based on a list. I just read I can use Autofilter with an array. Is it possible to input this array from a column instead of manually entering it in the VBA code? The list I'm using consists of 200 different strings and will be updated periodically.

    Where CritList is the list of strings. I still need to figure out how, but now I leave the office, so more tomorrow.

    EDIT1 Thanks to @DougGlancy; the autofiltering works now. Here is his beautiful code (I only added the array-filter).

    EDIT2 Included a more elaborate array-filter, where NameList is the list I would like to filter for. Now it all works!

    Sub FilterAndCopy()
    Dim LastRow As Long
    
    Dim vName As Variant
    Dim rngName As Range
    Set rngName = Sheets("Sheet3").Range("NameList")
    
    vName = rngName.Value
    
    Sheets("Sheet2").UsedRange.Offset(0).ClearContents
    With Worksheets("Sheet1")
        .Range("A:E").AutoFilter
    
        'Array filter from NameList
        .Range("A:J").AutoFilter Field:=3, Criteria1:=Application.Transpose(vName), _
                                    Operator:=xlFilterValues
    
        .Range("A:E").AutoFilter field:=2, Criteria1:="=String1" _
                                      , Operator:=xlOr, Criteria2:="=string2"
        .Range("A:E").AutoFilter field:=3, Criteria1:=">0", _
        .Range("A:E").AutoFilter field:=5, Criteria1:="Number"
    
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Destination:=Sheets("Sheet2").Range("A1")
    
    End With
    End Sub