Hi Experts

I have been working on making this small procedure. It
seems to work fine most of the time but very slow.
This is what it was intended to do
- Column A have list of Skus/Part# (could be upto 4000)
starting Row 2 (row 1 is a header)
- Col B is Quantity
- When the procedure is called it asks user if they would
like to Add up the quantity of duplicate skus. If yes is
selecetd it does so & advise by placing a comment in Col C
about how many times a particular Part# was duplicated
(one skus could be duplicated unlimited times)

What I would like your advise on is it seems to work fine
but ocasionally I have noticed it may not detect a
duplicate part (specially in very large data).
Also it seems bit slow & I am sure you may have a total
different and effecient aproach to this.
Also is there a way to actually put the result on a brand
new sheet created on fly.
I thought arrays could work faster but I dont have enough
have no knoledge on how to build it.

Thanks in advance for all your help
I use XL 2003 on Win2k


Sub RemoveDuplicates()
Call CheckL
Dim AddQty As Boolean
Dim DupeCounter
Dim FoundDupe As Boolean

Dim Response As Long
Response = MsgBox("Would You Like to Sum Up Quantities
for Duplicate Part#", vbYesNoCancel +
vbQuestion, "Duplicate Remover")
Select Case Response
Case 6 'User has clicked Yes
AddQty = True
Cells(1, 3).Value = "Qty Summed"
Case 7 'User has clicked No
AddQty = False
Cells(1, 3).Value = "Qty Not Summed"
Case 2 'User has clicked Cancel
Exit Sub

End Select
Application.ScreenUpdating = False
' log it
LogInfo ("Remove Duplicates," & vLastRow())
FoundDupe = False
For i = 2 To vLastRow()
PartNo = Cells(i, 1).Value
DupeCounter = 1
For j = i + 1 To vLastRow()
If PartNo = Cells(j, 1).Value Then
FoundDupe = True
' add up qty
If AddQty Then
Cells(i, 2).Value = Cells(i, 2).Value
+ Cells(j, 2).Value
End If
Cells(j, 1).Value = ""
Cells(j, 2).Value = ""
DupeCounter = DupeCounter + 1
End If
Next j
' advise user if duplicated

If DupeCounter 1 Then
Cells(i, 3).Value = "Duplicated x " &
DupeCounter
Else
Cells(i, 3).Value = ""
End If
Next i
' clean up loop to clear 0 values in qty
If AddQty Then
For i = 2 To vLastRow()
If Cells(i, 1).Value = "" Then
Cells(i, 2).Value = ""
Cells(i, 3).Value = ""
End If

Next i
End If
If FoundDupe Then
MsgBox "Duplicates Found" & vbCrLf & "Duplicates
Removed" & vbCrLf & vbCrLf & "(You May Need to Delete
Blank Rows Using DeW)" & vbCrLf, vbOKOnly + vbInformation
Else

MsgBox "No Duplicates Found", vbOKOnly +
vbInformation
Cells(1, 3).Value = ""
End If
Application.ScreenUpdating = True
End Sub