Typo...corrected..
Sub Macro()
'Adjust next constant to your own needs
Const myColumn As String = "B"
Dim rng As Range
Dim cell As Range
Dim Found As Range
Dim blnFound as Boolean
lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row
Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow)
rng.Interior.ColorIndex = xlNone
For Each cell In rng
If cell.Text <> "" And IsError(cell.Value) <> True Then
Set Found = rng.Find(cell.Value)
If Not Found Is Nothing Then
If Found.Address <> cell.Address Then
cell.Interior.Color = vbRed:blnFound = True
End If
End If
End If
Next
If blnFound = True then Msgbox "Duplicates Found"
End Sub
--
If this post helps click Yes
---------------
Jacob Skaria
"Jacob Skaria" wrote:
> Untested...Try and feedback
>
> Sub Macro()
> 'Adjust next constant to your own needs
> Const myColumn As String = "B"
> Dim rng As Range
> Dim cell As Range
> Dim Found As Range
> Dim blnCount as Boolean
>
> lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row
> Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow)
> rng.Interior.ColorIndex = xlNone
> For Each cell In rng
> If cell.Text <> "" And IsError(cell.Value) <> True Then
> Set Found = rng.Find(cell.Value)
> If Not Found Is Nothing Then
> If Found.Address <> cell.Address Then
> cell.Interior.Color = vbRed:blnFound = True
> End If
> End If
> End If
> Next
>
> If blnFound = True then Msgbox "Duplicates Found"
>
> End Sub
> --
> If this post helps click Yes
> ---------------
> Jacob Skaria
>
>
> "Freddy" wrote:
>
> > It worked very well. Can it be modified to inform the user whether or not
> > duplicates were found and, if necessary, make corrections then rerun the
> > macro to check for duplicates again?
> >
> > "Jacob Skaria" wrote:
> >
> > > Modified...Try the below and feedback
> > >
> > > Sub Macro()
> > > 'Adjust next constant to your own needs
> > > Const myColumn As String = "B"
> > > Dim rng As Range
> > > Dim cell As Range
> > > Dim Found As Range
> > >
> > > lngLastRow = ActiveSheet.Cells(Rows.Count, myColumn).End(xlUp).Row
> > > Set rng = Range(mycolumn & "1:" & mycolumn & lngLastRow)
> > > For Each cell In rng
> > > If cell.Text <> "" And IsError(cell.Value) <> True Then
> > > Set Found = rng.Find(cell.Value)
> > > If Not Found Is Nothing Then
> > > If Found.Address <> cell.Address Then cell.Interior.Color = vbRed
> > > End If
> > > End If
> > > Next
> > >
> > > End Sub
> > > --
> > > If this post helps click Yes
> > > ---------------
> > > Jacob Skaria
> > >
> > >
> > > "Freddy" wrote:
> > >
> > > > What VB macro code can be used to check for duplicate values AFTER all
> > > > entries are made into a column instead of as they are being entered? I am
> > > > running Microsoft Visual Basic 6.5 in Office 2002. I found the code below,
> > > > written by Ardus Petus, that checks for duplicate values AS THEY ARE ENTERED:
> > > >
> > > > '----------------------------------
> > > > Private Sub Worksheet_Change(ByVal Target As Range)
> > > > 'Adjust next constant to your own needs
> > > > Const myColumn As String = "B"
> > > > Dim rng As Range
> > > > Dim Found As Range
> > > >
> > > > Set rng = Columns(myColumn)
> > > > If Intersect(Target, rng) Is Nothing Then Exit Sub
> > > > Set Found = rng.Find(Target.Value)
> > > > If Found.Address <> Target.Address Then MsgBox ("Duplicate code")
> > > > End Sub
> > > > '-----------------------------------
> > > >
|
Similar Threads
