Bert328
Bert328

Reputation: 119

Filter for values that are <0.5 and delete visible rows

I want to filter my table by field 13 for values that are <0.5 and delete those visible rows.

I get the error code that no cells were found. There are values that meet the criteria.

Dim lo As ListObject
Set lo = Worksheets("Aluminum Futures").ListObjects("PF")

lo.Range.AutoFilter Field:=13, Criteria1:="<0.5"

Application.DisplayAlerts = False
lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True

lo.AutoFilter.ShowAllData

Upvotes: 1

Views: 804

Answers (4)

Bert328
Bert328

Reputation: 119

I created a new column where the cell values were that of the original multiplied by 1. This gave my the numerical filters that I needed.

Upvotes: 0

VBasic2008
VBasic2008

Reputation: 54898

Delete Filtered Rows in an Excel Table

  • Before applying a filter, it is always best to test for any previous filters and clear them to avoid filtering a filtered table (or range).
  • If you use 13 as the parameter of the Field argument of the AutoFilter method, then if you insert or delete a column to the left, the code will fail.
    Therefore it seems better to supply the column header (lcName = "Nums" (change to the actual header)) to reference the (list)column (lc) and use its Index property (lc.Index) as illustrated in the following code (recommended).
    On the other hand, if you now change the header, the code will again fail.
    In the end, it's up to you to decide which is less likely to happen.

The Code

Sub FilterTable()
    Const ProcName As String = "FilterTable"
    Dim AnErrorOccurred As Boolean
    Dim RowsDeleted As Boolean
    On Error GoTo ClearError ' enable the error-handling routine
    
    Const wsName As String = "Aluminum Futures"
    Const tblName As String = "PF"
    Const lcName As String = "Nums" ' adjust the criteria column header!
    Const CriteriaString As String = "<0.5"
    
    ' Reference the workbook, the worksheet, the table and the criteria column.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim tbl As ListObject: Set tbl = ws.ListObjects(tblName)
    Dim lc As ListColumn: Set lc = tbl.ListColumns(lcName)
    
    Application.ScreenUpdating = False
    
    ' Clear the table filters.
    ' If the autofilter arrows are turned off, turn them on.
    If tbl.ShowAutoFilter Then
        If tbl.AutoFilter.FilterMode Then tbl.AutoFilter.ShowAllData
    Else
        tbl.ShowAutoFilter = True
    End If
    
    ' Filter the table.
    tbl.Range.AutoFilter lc.Index, CriteriaString
    
    ' Attempt to reference the filtered rows.
    Dim frrg As Range
    On Error Resume Next ' defer error trapping
        Set frrg = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo ClearError ' re-enable the error-handling routine
    
    tbl.AutoFilter.ShowAllData ' clear the table filter
    
    If Not frrg Is Nothing Then
        frrg.Delete xlShiftUp ' delete filtered rows
        RowsDeleted = True
        'wb.Save
    End If
    
ProcExit:
    On Error Resume Next ' defer error trapping (to prevent an endless loop)
        If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
        ' Inform.
        If AnErrorOccurred Then
            MsgBox "An error occurred.", vbCritical, ProcName
        Else
            If RowsDeleted Then
                MsgBox "Filtered rows deleted.", vbInformation, ProcName
            Else
                MsgBox "No filtered rows.", vbExclamation, ProcName
            End If
        End If
    On Error GoTo 0 ' disable error trapping
    
    Exit Sub
ClearError: ' Error-Handling Routine
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    AnErrorOccurred = True
    Resume ProcExit
End Sub

By-Products (not used in the code)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns a reference to an Excel table in a worksheet
'               of a given workbook.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefTable( _
    ByVal wb As Workbook, _
    ByVal WorksheetName As String, _
    ByVal TableName As String) _
As Excel.ListObject
    Const ProcName As String = "RefTable"
    On Error GoTo ClearError

    Dim ws As Worksheet: Set ws = wb.Worksheets(WorksheetName)
    Dim tbl As ListObject: Set tbl = ws.ListObjects(TableName)

    Set RefTable = tbl

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function
  • In this particular case, to reference the table, one could use:

    Dim tbl As ListObject: Set tbl = RefTable(wb, wsName, tblName)
    

    to skip referencing the worksheet, or even:

    Dim tbl As ListObject: Set tbl = RefTable(ThisWorkbook, wsName, tblName)
    

    to additionally skip referencing the workbook.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Clears the filters of an Excel table.
' Remarks:      If the autofilter arrows are turned off, it turns them on.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ClearTableFilters( _
        ByVal tbl As ListObject)
    Const ProcName As String = "ClearTableFilters"
    On Error GoTo ClearError
    
    If tbl.ShowAutoFilter Then
        If tbl.AutoFilter.FilterMode Then tbl.AutoFilter.ShowAllData
    Else
        tbl.ShowAutoFilter = True
    End If

ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub
  • In this particular case, to clear the filters, one could use:

    ClearTableFilters tbl
    

Upvotes: 0

data_sc
data_sc

Reputation: 457

You could try searching for your column to get proper column index. As your code works when I tested.

FilterRow = Rows("1:1").Find(What:="ID", LookAt:=xlWhole).Column

lo.Range.AutoFilter Field:=FilterRow, Criteria1:="<0.5"

Upvotes: 0

Byrd
Byrd

Reputation: 379

I don't think you're doing anything wrong here. I used the code, it ran the first time and worked. Every subsequent run through and error saying nothing found like you were saying. Because they were all deleted already. So I did this. It's a quick fix. Granted it's going to do that anytime there is an error when deleting though. Make sure 13 is actually the column you need too like people are mentioning.

Sub Button1_Click()
Dim lo As ListObject
Set lo = Worksheets("Sheet1").ListObjects("Table1")

lo.Range.AutoFilter Field:=13, Criteria1:="<0.5"

On Error GoTo NothingFound
    Application.DisplayAlerts = False
    lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete

NothingFound:
    Application.DisplayAlerts = True
    lo.AutoFilter.ShowAllData
End Sub

Upvotes: 0

Related Questions