excelvbarangeadvanced-filter

Excel VBA Advanced Filter to not copy all columns


I'm using AdvancedFilter for the first time in VBA. I'm trying to copy only specific columns from the source data table to an external workbook table. I've seen how it should be specified when doing it not in VBA, but it's not working in my code.

Currently, the filtering works and it's copying to the external workbook table, BUT it's copying all the headings and filtered data, and pasting everything into the external table, not just the columns that are in my external table.

The code runs without any error messages.

So the outcome I want is

Current code:

Sub StockManagement(wb As Workbook, ws As Worksheet)
Dim TemplPath As String
Dim SMTemp As String
Dim SMTempF As String  

'Create Filter Criteria ranges
With MainWB.Worksheets.Add
    .Name = "FltrCrit"
    Dim FltrCrit As Worksheet
    Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With

With FltrCrit
    Dim DerangedCrit As Range
    Dim myLastColumn As Long

    'Create Deranged Filter Criteria Range
    .Cells(1, "A") = "Deranged"
    .Cells(2, "A") = "MS"
    .Cells(3, "A") = "<>4"
    .Cells(2, "B") = "SOH"
    .Cells(3, "B") = "=0"

    'get last column, set range name
    With .Cells

        'find last column of data cell range
        myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

        'specify cell range
        Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))

    End With


'Copy Filtered data to specified tables
Dim tblSDC As ListObject, tblFiltered As ListObject
Dim shSDC As Worksheet, shFiltered As Worksheet
Dim critRange As Range, copyToRng As Range, SDCRange As Range

'Assign values to sheet variables
Set shSDC = MainWB.Worksheets(2)
Set shFiltered = wb.Worksheets("Deranged with SOH")

'Turn off autofilter on filtered tab
shFiltered.AutoFilterMode = False

'Store Filtered table in variable
Set tblFiltered = shFiltered.ListObjects("Table_Deranged_with_SOH")
Set tblSDC = shSDC.ListObjects("Table_SDCdata")

'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData

'Set Criteria range to variable
Set critRange = DerangedCrit

'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.DataBodyRange(1, 1)
Set SDCRange = tblSDC.Range

'Use Advanced Filter
SDCRange.CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critRange, CopyToRange:=copyToRng, Unique:=False

Any help will be appreciated.

EDIT:

If I set the external/output range to

Set copyToRng = tblFiltered.HeaderRowRange

It makes sense to me that it'll behave in the same way as if you used the Advanced Filter without VBA. So you set the output table range to the output table range headers, and that should then just copy all the columns that match. BUT when I do that, nothing is copied, the output/external table is empty.

So any suggestions will be helpful thanks.


Solution

  • Mystery solved, It was a silly error. The code works absolutely fine, the problem that the external/output table was empty was because one of my headers in the external/output table had an extra space in, so it couldn't match to the source data headers.

    I did adjust the code slightly to remove some of the variables (as suggested by @Tim Williams) above.

    Code now looks as like this:

    Sub StockManagement(wb As Workbook, ws As Worksheet)
    Dim TemplPath As String
    Dim SMTemp As String
    Dim SMTempF As String  
    
    'Create Filter Criteria ranges
    With MainWB.Worksheets.Add
        .Name = "FltrCrit"
        Dim FltrCrit As Worksheet
        Set FltrCrit = MainWB.Worksheets("FltrCrit")
    End With
    
    With FltrCrit
        Dim DerangedCrit As Range
        Dim myLastColumn As Long
    
        'Create Deranged Filter Criteria Range
        .Cells(1, "A") = "Deranged"
        .Cells(2, "A") = "MS"
        .Cells(3, "A") = "<>4"
        .Cells(2, "B") = "SOH"
        .Cells(3, "B") = "=0"
    
        'get last column, set range name
        With .Cells
    
            'find last column of data cell range
            myLastColumn = .Find(What:="*", After:=.Cells(2), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    
            'specify cell range
            Set DerangedCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))
    
        End With
    
    'Copy Filtered data to specified tables
    Dim tblFiltered As ListObject
    Dim copyToRng As Range, SDCRange As Range
    
    'Store Filtered table in variable
    Set tblFiltered = wb.Worksheets("Deranged with SOH").ListObjects("Table_Deranged_with_SOH")
    
    'Remove Filtered table Filters
    tblFiltered.AutoFilter.ShowAllData
    
    'Set Copy to range on Filtered sheet table
    Set copyToRng = tblFiltered.HeaderRowRange
    Set SDCRange = MainWB.Worksheets(2).ListObjects("Table_SDCdata").Range
    
    'Use Advanced Filter
    SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=DerangedCrit, CopyToRange:=copyToRng, Unique:=False