Sub Del_Rows_n_Cols_on_Condition_AllWS_AllWB_Same_Folder()
'http://www.vbaexpress.com/forum/showthread.php?48681-Selecting-and-deleting-rows-based-on-criteria
Dim wb As Workbook, ws As Worksheet
Dim fRange As Range, delRng As Range
Dim FirstRowQ As Variant
Dim i As Long, FR As Long, LR As Long, LC As Long
Dim fName, fPath As String
fPath = "C:\Files\" 'change to suit. include final \
fName = Dir(fPath & "*.xls*")
Do While fName <> ""
Set wb = Workbooks.Open(fPath & fName)
wb.Worksheets(1).Activate
FirstRowQ = MsgBox(wb.Name & vbLf & vbLf & "Is the first row the same in each worksheet?", vbYesNoCancel, "First Row Decision")
If FirstRowQ = vbYes Then
Set fRange = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8)
FR = fRange.Row
For Each ws In wb.Worksheets
With ws
LR = .Cells.Find("(1) Includes", , , xlPart, xlByRows, xlPrevious).Row - 3
LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
delRng.AutoFilter Field:=3, Criteria1:=Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW"), Operator:=xlFilterValues 'filters table for matches in Column C
.AutoFilter.Range.Rows.Delete 'deletes all rows of auto filter range
.AutoFilterMode = False
delRng.Columns(1).SpecialCells(4).EntireRow.Delete 'deletes all rows of blank cells in the table's first column (which is Column A)
.Rows(FR).SpecialCells(4).EntireColumn.Delete 'deletes all columns of blank cells in the selected First Row
End With
Next ws
ElseIf FirstRowQ = vbNo Then
For Each ws In wb.Worksheets
With ws
.Activate
Set fRange = Application.InputBox("Select the first row in each worksheet", "First Row Selection", Type:=8)
FR = fRange.Row
LR = .Cells.Find("(1) Includes", , , xlPart, xlByRows, xlPrevious).Row - 3
LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
delRng.AutoFilter Field:=3, Criteria1:=Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW"), Operator:=xlFilterValues
.AutoFilter.Range.Rows.Delete
.AutoFilterMode = False
delRng.Columns(1).SpecialCells(4).EntireRow.Delete
.Rows(FR).SpecialCells(4).EntireColumn.Delete
End With
Next ws
Else
MsgBox "You cancelled the code execution. Quitting...", vbOKOnly, "QUIT"
wb.Close SaveChanges:=False
Exit Sub
End If
wb.Close SaveChanges:=True
fName = Dir()
Loop
End Sub