This will delete the rows for you. Hope this helps! If so, let me know,
click "YES" below.

Sub DeleteRows()

Dim LastRow As Long
Dim rw As Long

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

For rw = LastRow To 2 Step -1
If Cells(rw, "B").Value < "Apples" Or Cells(rw, "B").Value <
"Oranges" Then
Rows(rw).Delete Shift:=xlUp
End If
Next rw

Application.ScreenUpdating = True

End Sub

You are vague on the criteria for the second part. Please explain in
further detail.
--
Cheers,
Ryan


"J.W. Aldridge" wrote:

Headers on row 1.
Data in A:AD
Criteria in column B.

Delete rows if the value in row B does not equal "Apples" or "oranges"

Then create sheets based on value in A, and copy the data onto each
sheet based on the data in A and the name of sheet.


.