AutoFilter not working as intended, copies the whole table content when filter is not existing

Question

I have the following issue with my VBA code: I want to filter a table for a specific value (in this case "FALSCH") and copy it into another table. This works pretty well, except for the case that there is no cell in the specific column with the value "FALSCH".

Then my code marks and copies the whole content of my table which I don't want. I tried many ways to fix this issue but nothing not working and I don't know anymore...

Maybe someone could help me with this? Thanks in advance!

Code:

    ActiveSheet.ListObjects("Tabelle328").Range.AutoFilter Field:=6, Criteria1:="FALSCH"
    Range("Tabelle328").Select
    Selection.Style = "40 % - Akzent2"
    Range("Tabelle328[[GuV Ext. CMIS]:[Kontostand]]").Select
    Selection.Copy
    
    Range("O12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   ActiveSheet.ListObjects("Tabelle328").Range.AutoFilter Field:=6

Darren Bartrup-Cook · Answer 1 · 2023-07-04T08:55:57.363

No need to select anything, and On Error Resume Next shouldn't be used in most cases. It hides all errors, best to check if the error can be avoided all together.

Edit 2: Have left original code at bottom of post to put comments in context. Not sure about the Autofilter needs a header range - I think I've assumed this before, but filtering DataBodyRange did filter out the first row when it didn't contain the filter text. I've used COUNTA (3) with the SUBTOTAL to count the visible rows in the range.

Sub Test()

    'Be explicit where the table is.  ThisWorkbook is the file containing the code, Tabell328 is on Sheet1.
    Dim lo As ListObject
    Set lo = ThisWorkbook.Worksheets("Sheet1").ListObjects("Tabelle328")
    
    With lo
        .Range.AutoFilter Field:=6, Criteria1:="FALSCH"
        
        'How many rows are left?
        If Application.WorksheetFunction.Subtotal(3, .ListColumns(1).DataBodyRange) > 0 Then
            
            'Set a reference to the visible cells.
            'Start at "GuV Ext. CMIS" and the next two columns.
            Dim RangeToCopy As Range
            Set RangeToCopy = .ListColumns("GuV Ext. CMIS").DataBodyRange.Resize(, 3).SpecialCells(xlCellTypeVisible)
        
            'Copy and paste just the values to the destination.
            RangeToCopy.Copy
            ThisWorkbook.Worksheets("Sheet1").Range("O12").PasteSpecial Paste:=xlPasteValues
            
        Else
            MsgBox "No rows to copy"
        End If
    End With

End Sub

Original code - see comments as to why it wouldn't always work.

Sub Test()

    'Be explicit where the table is.  ThisWorkbook is the file containing the code, Tabell328 is on Sheet1.
    Dim lo As ListObject
    Set lo = ThisWorkbook.Worksheets("Sheet1").ListObjects("Tabelle328")
    
    With lo
        'Filter just the body of data, not the table headers as well.
        .DataBodyRange.AutoFilter Field:=6, Criteria1:="FALSCH"
        
        'How many rows are left?  Just the headers, or more than that?
        If lo.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
            
            'Set a reference to the visible cells.
            'Start at "GuV Ext. CMIS" and the next two columns.
            Dim RangeToCopy As Range
            Set RangeToCopy = lo.ListColumns("GuV Ext. CMIS").DataBodyRange.Resize(, 3).SpecialCells(xlCellTypeVisible)
        
            'Copy and paste just the values to the destination.
            RangeToCopy.Copy
            ThisWorkbook.Worksheets("Sheet1").Range("O12").PasteSpecial Paste:=xlPasteValues
            
        Else
            MsgBox "No rows to copy"
        End If
    End With

End Sub

Edit: Change .DataBodyRange.Resize(, 3) to .Range.Resize(,3) in RangeToCopy if you want to include headers.

With statement
How to avoid using Select in Excel VBA

While you can loop through the rows of a non-contiguous range successfully, its `.Rows.Count` returns only the number of rows of its first area (best try it on your own with e.g. `Debug.Print Range("A1,A3,A5").Rows.Count`). *AutoFilter* needs a header row. If you use the data body range, the first data row will be excluded. There are two redundant occurrences of `lo` in the *With* statement. — VBasic2008, Jul 04 '23 at 08:26
@VBasic2008 Good spot on the lo - split it out into a `With...End With` block and forgot to remove most of the references inside. Yes, didn't think about it too much while writing the code and left out some stuff I really should know by now. I'll update. — Darren Bartrup-Cook, Jul 04 '23 at 08:30

VBasic2008 · Answer 2 · 2023-07-04T08:04:22.653

Return Filtered Data From an Excel Table (`ListObject`)

It is assumed that you know the title of the criteria column (Richtig/Falsch) instead of its index (6).

VBA

Sub FilterVBA()
    
    ' Define constants.
    Const SRC_TABLE As String = "Tabelle328"
    Const SRC_FIRST_COLUMN As String = "GuV Ext. CMIS"
    Const SRC_LAST_COLUMN As String = "Kontostand"
    Const SRC_CRITERIA_COLUMN As String = "Richtig/Falsch"
    Const CRITERION As String = "Falsch"
    Const DST_FIRST_CELL As String = "O12"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Ensure the workbook is active...
    If Not wb Is ActiveWorkbook Then wb.Activate
    ' ... to reference the table when the name of the worksheet is unknown:
    Dim lo As ListObject: Set lo = Range(SRC_TABLE).ListObject
    
    Dim ws As Worksheet: Set ws = lo.Range.Worksheet
    
    ' Reference the copy columns' data body range (headers excluded).
    Dim CopyAddress As String: CopyAddress = SRC_TABLE & "[[" _
        & SRC_FIRST_COLUMN & "]:[" & SRC_LAST_COLUMN & "]]"
    Dim crg As Range: Set crg = ws.Range(CopyAddress)
    
    ' Filter the table and reference the visible range (headers excluded).
    Dim vrg As Range
    With lo
        ' Clear filter.
        If .ShowAutoFilter Then ' prevent error if not in 'auto filter mode'
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
        ' Filter.
        .Range.AutoFilter .ListColumns(SRC_CRITERIA_COLUMN).Index, CRITERION
        ' Attempt to reference the visible range.
        On Error Resume Next
            Set vrg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        ' Clear filter.
        .AutoFilter.ShowAllData
    End With
    
    ' Reference the first destination row.
    Dim drrg As Range:
    Set drrg = ws.Range(DST_FIRST_CELL).Resize(, crg.Columns.Count)
    ' Clear below (incl. first row).
    drrg.Resize(ws.Rows.Count - drrg.Row + 1).Clear
    
    If Not vrg Is Nothing Then ' the visible range was referenced
        
        ' Reference only the copy columns of the visible range.
        Set vrg = Intersect(crg, vrg)
        
        Dim arg As Range, arCount As Long
        ' Copy only values 'by assignment'.
        For Each arg In vrg.Areas
            arCount = arg.Rows.Count
            drrg.Resize(arCount).Value = arg.Value
            Set drrg = drrg.Offset(arCount)
        Next arg
    
    'Else ' the visible range was not referenced (no match)
    End If
    
End Sub

Microsoft 365 Formula

In cell O12:

=FILTER(Tabelle328[[GuV Ext. CMIS]:[Kontostand]],Tabelle328[Richtig/Falsch]="Falsch","")

You can write the formula using VBA in the following way (not quite sure why you would do it though):

Sub FilterFormula()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Ensure the workbook is active...
    If Not wb Is ActiveWorkbook Then wb.Activate
    ' ... to reference the worksheet when its name is unknown:
    Dim ws As Worksheet: Set ws = Range("Tabelle328").ListObject.Range.Worksheet

    ' Write formula.
    ws.Range("O12").Formula2 = "=FILTER(Tabelle328[[GuV Ext. CMIS]" _
        & ":[Kontostand]],Tabelle328[Richtig/Falsch]=""Falsch"","""")"

    ' Convert to values (not recommended i.e. why?).
'    With ws.Range("O12").CurrentRegion
'        .Value = .Value
'    End With

End Sub

ΑΓΡΙΑ ΠΕΣΤΡΟΦΑ · Accepted Answer · 2023-07-03T14:20:23.767

Try to declare Option Explicit in every Section. Do not use Select to refer to an entity, but make a direct reference to it. In your case you have to select the cells with the property xlCellTypeVisible, as in the example:

Option Explicit

Sub Unckown()
   Dim visRng As Range
   ActiveSheet.ListObjects("Tabelle328").Range.AutoFilter field:=6, Criteria1:="FALSCH"
   On Error Resume Next
   Set visRng = Range("Tabelle328").SpecialCells(xlCellTypeVisible)
   On Error GoTo 0
   If Not visRng Is Nothing Then
      'visRng.Style = "40 % - Akzent2"
      Range("Tabelle328[[GuV Ext. CMIS]:[Kontostand]]").Copy
      Range("O12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   End If
   ActiveSheet.ListObjects("Tabelle328").Range.AutoFilter field:=6
End Sub

score -1 · Answer 4 · answered Jul 03 '23 at 14:04

Try this

ActiveSheet.ListObjects("Tabelle328").Range.AutoFilter Field:=6, Criteria1:="FALSCH"

Dim filteredRange As Range
On Error Resume Next
Set filteredRange = ActiveSheet.ListObjects("Tabelle328").Range.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not filteredRange Is Nothing Then
    Range("Tabelle328").Style = "40 % - Akzent2"
    Range("Tabelle328[[GuV Ext. CMIS]:[Kontostand]]").Copy
    Range("O12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

ActiveSheet.ListObjects("Tabelle328").Range.AutoFilter Field:=6

AutoFilter not working as intended, copies the whole table content when filter is not existing

4 Answers4

Return Filtered Data From an Excel Table (ListObject)

Return Filtered Data From an Excel Table (`ListObject`)