Delete Rows with Autofilter and partial cell.

[Spy128Bit]

Instead of looping through every row as seen in my current script
below I'm trying to combine the use of autofilter but am having
difficulty in getting the use of "Left(Cells(RowNdx, "A"), 9) Like
"#########"" right in the macro. Any help would be appreciated or any
other ideas can be tried. Thank in advance!

http://www.rondebruin.nl/delete.htm#AutoFilter
Sub Delete_with_Autofilter()
Dim DeleteValue As String
Dim rng As Range
DeleteValue = "ron"
' This will delete the rows with "ron" in the Range("A1:A100")
With ActiveSheet
.Range("A1:A100").AutoFilter Field:=1, Criteria1:=DeleteValue
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub

Sub Auto_TC_DelExtra()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Lastrow As Long
Dim RowNdx As Long
With Sheets("Data")
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For RowNdx = Lastrow To 1 Step -1
If Not (Left(Cells(RowNdx, "A"), 9) Like "#########") Then
Rows(RowNdx).Delete
End If
Next RowNdx
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Tom Ogilvy]

Autofilter doesn't support that type of criteria.

You could use a column to the right with a formula that does, but if you do
that it would be easier to do it like this:

Sub Auto_TC_DelExtra()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Lastrow As Long
Dim RowNdx As Long
Dim dum_col as Long
Dim rng as Range
With Sheets("Data")
Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
dum_col = .Cells(Columns.count,1).End(xltoLeft).Column + 1
set rng = .Range(.Cells(2,dum_col),.Cells(lastrow,dum_col))
rng.formula = "=Left(A2,9)*1"
on Error Resume Next
rng.SpecialCells(xlFormulas,xlErrors).EntireRow.Delete
On Error goto 0
.Columns(dum_col).ClearContents
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

If you selected all the cells in column A that you wanted to delete and it
came out to be more than 8192 separate areas (bunches of non contiguous
cells), then use of specialcells would require special handling.