Check for Duplicates (RP)

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:D" & 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

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:D" & 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

--
Regards,
Tom Ogilvy

"Steph" <[email protected]> wrote in message
news:%[email protected]...
> 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:D" & 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
>
>
>

Thanks Tom!

"Tom Ogilvy" <[email protected]> wrote in message
news:[email protected]...
> 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:D" & 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
>
> --
> Regards,
> Tom Ogilvy
>
> "Steph" <[email protected]> wrote in message
> news:%[email protected]...
> > 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:D" & 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
> >
> >
> >
>
>