This should do it. Assumes the data starts on row 2:


Code
-------------------
Sub DeleteAllBut7()

Dim i As Long
Dim iStart As Long
Dim iEnd As Long

iStart = 2 'Assumes data starts on row 2
iEnd = Range("B65536").End(xlUp).Row

For i = iStart To iEnd
If Range("B" & i).Value < "Name1" And _
Range("B" & i).Value < "Name2" And _
Range("B" & i).Value < "Name3" And _
Range("B" & i).Value < "Name4" And _
Range("B" & i).Value < "Name5" And _
Range("B" & i).Value < "Name6" And _
Range("B" & i).Value < "Name7" Then
Range("B" & i).Value = ""
End If
Next

Range("B" & iStart & ":B" & iEnd).SpecialCells(xlCellTypeBlanks).EntireRow.Del ete

End Su
-------------------

It basically sets the B column to a blank if the name doesn't exist
then deletes all rows with blanks in column B.



--
Message posted from http://www.ExcelForum.com