I would add a new column C (just temporarily).

Then in C6, I'd add this formula:
=if(countif($b$6:$b$5000,b6)1,"ok",na())
and drag down.

This would result in an error on every row that had exactly one occurrence.

Then I'd select that range
convert to values (to remove the slow calculation)
Edit|goto|special|constants and errors
delete those selected rows
delete column C.

In code:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim myRng As Range

Set wks = Worksheets("Sheet1")

With wks

Set myRng = .Range("B5:B5000")

myRng.Cells(1).Offset(0, 1).EntireColumn.Insert

With myRng.Offset(0, 1)
.Formula = "=if(countif(" & myRng.Address & "," _
& myRng.Cells(1).Address(0, 0) & ")1,""ok"",na())"
.Value = .Value
End With

On Error Resume Next 'in case there are no errors
myRng.Offset(0, 1).Cells.SpecialCells(xlCellTypeConstants, xlErrors) _
.EntireRow.Delete
On Error GoTo 0

'remove the helper column
myRng.Cells(1).Offset(0, 1).EntireColumn.Delete

End With

End Sub

"J.W. Aldridge" wrote:

i have headers in a5:g5
I have data in columns A6:G5000.

based on the series of numbers in column b, i want to delete all
single occurances of the number found.

In other words, if it is not listed/found in column B at least twice,
delete the entire row.

--

Dave Peterson