Sub Delete_All_Y()
Dim sht As Worksheet
On Error GoTo ErrHandler
Set sht = ThisWorkbook.Worksheets("Sheet1")
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table3").Sort.SortFields.Add _
Key:=Range("Table3[[#All],[Column16]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table3").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With [Z2]
.Offset(0, 0).Resize(.CurrentRegion.Rows.Count, 1). _
SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Select
ActiveCell.Offset(-1, 0).Activate
Range(ActiveCell, ActiveCell.End(xlUp)).Offset(1, 0).Select
Selection.Value = ""
[Z2].Value = "Column16"
End With
Application.CutCopyMode = False
Call NextARow
Exit Sub
ErrHandler:
MsgBox "There are no cells with Y"
Application.CutCopyMode = False
Exit Sub
End Sub
Sub NextARow()
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastRow = ActiveSheet.Range("A65536").End(xlUp).Row
Cells(LastRow, 1).Select
End Sub