Check for Duplicates (RP)

[Steph]

Hi. The code below is compliments of Bob Phillips. It scans the contents
of column D, and finds duplicates. If the code finds them, a message box
displaying where the dulicates are found is displayed. This code works
great if there are duplicates found. If there are no duplicates, I get an
Invalid procedure call or argument error, with the line sCells =
Left(sCells, Len(sCells) - 1) highlighted by the debugger. Any ideas how
to fix? Thank you!!

Sub Dups()
Dim iLastRow As Long
Dim i As Long
Dim sCells As String
Dim rng As Range

iLastRow = Cells(1499, "B").End(xlUp).Row 'Cells(Rows.Count, "B")
Set rng = Range("D1" & iLastRow)
For i = 1 To iLastRow
If Application.CountIf(rng, Cells(i, "D")) > 1 Then
sCells = sCells & Cells(i, "D").Address(False, False) & ","
End If
Next i
sCells = Left(sCells, Len(sCells) - 1)
If Not IsEmpty(sCells) Then
MsgBox "Duplicates found in " & vbCrLf & sCells
Else
MainUpdate
End If
End Sub

 

[Tom Ogilvy]

sCells will never be empty since it is initialized as a null string. But
you can do

Sub Dups()
Dim iLastRow As Long
Dim i As Long
Dim sCells As String
Dim rng As Range

iLastRow = Cells(1499, "B").End(xlUp).Row 'Cells(Rows.Count, "B")
Set rng = Range("D1" & iLastRow)
For i = 1 To iLastRow
If Application.CountIf(rng, Cells(i, "D")) > 1 Then
sCells = sCells & Cells(i, "D").Address(False, False) & ","
End If
Next i
If sCells <> "" Then
sCells = Left(sCells, Len(sCells) - 1)
MsgBox "Duplicates found in " & vbCrLf & sCells
Else
MainUpdate
End If
End Sub

 

[Steph]

Thanks Tom!

sCells will never be empty since it is initialized as a null string. But
you can do

Sub Dups()
Dim iLastRow As Long
Dim i As Long
Dim sCells As String
Dim rng As Range

iLastRow = Cells(1499, "B").End(xlUp).Row 'Cells(Rows.Count, "B")
Set rng = Range("D1" & iLastRow)
For i = 1 To iLastRow
If Application.CountIf(rng, Cells(i, "D")) > 1 Then
sCells = sCells & Cells(i, "D").Address(False, False) & ","
End If
Next i
If sCells <> "" Then
sCells = Left(sCells, Len(sCells) - 1)
MsgBox "Duplicates found in " & vbCrLf & sCells
Else
MainUpdate
End If
End Sub