ANmaFilter3

Filter database into new sheet, by copying certain columns only, not whole table.
Fastest way I found so far to move filtered data into new sheet.
Tried Advanced Filter, Pivot, and VBA-pure method, all were not as fast as this method.
Accepts up to 3 columns to filter, each with one condition only, maybe in near future we can add more conditions and more columns.

CodeFunctionName

What is this?

Public

Tested

Original Work

Sub ANmaFilter3(SrcCellA1, ColumnList, Move2Sheet _
    , Filter1Col, Filter1Val _
    , Optional Filter2Col = 0, Optional Filter2Val = "" _
    , Optional Filter3Col = 0, Optional Filter3Val = "" _
    , Optional SrcSheet = "Active", Optional SrcWB = "This" _
    , Optional Move2WB = "This" _
    )
    '
    ' Filters a table showing only few rows.
    '    Doing what AdvancedFilter does but in a faster way since we are only showing some columns, not all.
    '
    ' SrcCellA1, SrcSheet, SrcWB: Starting cell of big db to filter, sheet name, and workbook name
    ' ColumnList: List of columns to be moved, [D,G,K,UZ] not all columns will be moved, but we need to bring any column we need to filter by.
    ' Move2Sheet: Sheet will move data to, [Sheet3] will be cleared, has to be blank.
    ' Filter1Col, Filter1Val: Column Index to filter by [3], value (or full condition of filter, like >3, < >"Ream", etc. ) [4]
    ' ...
    '
    If SrcWB = "This" Then SrcWB = ThisWorkbook.Name
    If SrcWB = "Active" Then SrcWB = ActiveWorkbook.Name
    If SrcSheet = "Active" Then SrcSheet = Workbooks(SrcWB).ActiveSheet.Name
    If Move2WB = "This" Then Move2WB = ThisWorkbook.Name
    If Move2WB = "Active" Then Move2WB = ActiveWorkbook.Name

    OldScrUpd = Application.ScreenUpdating
    OldCalc = Application.Calculation
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Style4 = AutoFilter, Filter sheet in place after moving some columns, not all > > Very fast comparing with other solutions
    DBRows = Workbooks(SrcWB).Worksheets(SrcSheet).Range("A1").CurrentRegion.Rows.Count

    Workbooks(Move2WB).Worksheets(Move2Sheet).AutoFilterMode = False
    Workbooks(Move2WB).Worksheets(Move2Sheet).Range("D1").EntireColumn.EntireRow.Clear
    X1 = 0
    For Each Coo in Split(ListColumns, ",")
        DBR1 = "$" & Coo & "$1:$" & Coo & "$" & DBRows
        Workbooks(Move2WB).Worksheets(Move2Sheet).Range("D1:D" & DBRows).Offset(0, X1).Value = Workbooks(SrcWB).Worksheets(SrcSheet).Range(DBR1).Value
        X1 = X1 + 1
    Next
    Move2Range = "$D$1:$" & ColumnName("D1", X1) & "$" & DBRows
    Workbooks(Move2WB).Worksheets(Move2Sheet).Range(Move2Range).AutoFilter Filter1Col, Filter1Val
    If Filter2Col > 0 And Filter2Val > "" Tnen
        Workbooks(Move2WB).Worksheets(Move2Sheet).Range(Move2Range).AutoFilter Filter2Col, Filter2Val
    End If
    If Filter3Col > 0 And Filter3Val > "" Tnen
        Workbooks(Move2WB).Worksheets(Move2Sheet).Range(Move2Range).AutoFilter Filter3Col, Filter3Val
    End If

    Application.ScreenUpdating = OldScrUpd
    Application.Calculation = OldCalc
End Sub

SrcCellA1, ColumnList, Move2Sheet , Filter1Col, Filter1Val, Optional Filter2Col = 0, Optional Filter2Val = "", Optional Filter3Col = 0, Optional Filter3Val = "", Optional SrcSheet = "Active", Optional SrcWB = "This", Optional Move2WB = "This"