Check Duplicates - Speed it up.
I had a requirement to check for the presence of duplicates in a column in Excel.
I have written a function for this purpose and it works. The drawback is that it is an extremely slow function and takes about 6 minutes to check across 20000 rows. Could someone take a look and speed up the function?
VB Code:
Sub CheckDuplicate()
Dim txtSearchVal As String
Dim lCtr As Long
Dim lCtr2 As Long
Dim bFound As Boolean
For lCtr2 = 1 To 20000
txtSearchVal = Sheet1.Cells(lCtr2, 1)
For lCtr = (lCtr2 + 1) To 20000
If Sheet1.Cells(lCtr, 1) = txtSearchVal Then
Sheet1.Cells(lCtr, 1).Font.Color = vbRed
Sheet1.Cells(lCtr, 1).Font.Bold = True
'Sheet1.Cells(lCtr, 1).AddComment ("Duplicate Values")
Exit For
End If
Next lCtr
Next lCtr2
End Sub
Re: Check Duplicates - Speed it up.
Do you have data all the way to the 20000th row?
Re: Check Duplicates - Speed it up.
Re: Check Duplicates - Speed it up.
I have used this page a few times to straighten me out in my coding endeavors:
http://www.ozgrid.com/VBA/VBALoops.htm
Here is what I think might interest you, modified slightly to your needs:
VB Code:
Sub Dupes()
Dim DupeValue As Double
Dim ii As Integer
DupeValue = 2 'whatever
If WorksheetFunction.CountIf(Cells, DupeValue) = 0 Then
MsgBox "No duplicate values."
Exit Sub
End If
Range("A1").Select
For ii = 1 To WorksheetFunction.CountIf(Cells, DupeValue)
Cells.Find(What:=2, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ActiveCell.Interior.ColorIndex = 4 'green highlight
Next ii
End Sub
This still uses a loop, and perhaps someone else knows the way to get the cells.find function to find ALL the values at once, and not just the first one. I looked, but I didn't find any resources regarding that. :(
This loop's running time will directly depend on the number of duplicates in the sheet. If its only a few hundred, it shouldn't take too long to run at all, even on this old Pentium 166.
Hope this helps you out!