Reputation: 119
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
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
Reputation: 54898
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.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).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
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
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