Speed Up Macro: Deletes All Duplicates

It takes all numbers in column 4 starting with Row 15 and deletes all duplicates. It then shows the number of times the number was duplicated and puts this number in column 3. MY PROBLEM: The macro searches each line and takes FOREVER! I have data with thousands of lines. I already tried the screenupdating method which really doesn't help that much. Is there possibly a better code for doing this?

Sub Factor()
Dim sID As String
Dim sOldID As String
Dim lLastRow As Long
Dim lrow As Long
Dim lcount As Long
Dim lLoop As Long
lLastRow = ActiveSheet. Cells(Rows.Count, 1).End(xlUp).Row
lrow = 15
sID = ActiveSheet.Cells(lrow, 4).Value
sOldID = "ActiveSheet.Cells(4, 15).Value"
lcount = 1
lLoop = 1
Do While Len(sID) <> 0
If sID <> sOldID Then
If lLoop = 1 Then.................................