Highlight duplicates

Hello SITCFanTN,

Add a VBA module to your Workbook and paste the macro code below into it.

Sub HighlightDuplicates()

'Highlight duplicates in Yellow
  Dim Cell As Range
  Dim Cell_Range As Range
  Dim MyCollection As New Collection
  
    'Find last cell entry in the row
     LastEntry = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Address
    'Define the range to examine
     Set Cell_Range = ActiveSheet.Range("B1", LastEntry)
    
    For Each Cell In Cell_Range
      On Error Resume Next
      MyCollection.Add Item:="1", Key:=Cell.Text
        If Err.Number = 457 Then
           Cell.Interior.ColorIndex = 6
           Err.Clear
        End If
    Next Cell
  
End Sub

Sincerely,
Leith Ross

This worked great, thanks a bunch Leith!

"Leith Ross" wrote:

>
> Hello SITCFanTN,
>
> Add a VBA module to your Workbook and paste the macro code below into
> it.
>
>
> Code:
> --------------------
>
> Sub HighlightDuplicates()
>
> 'Highlight duplicates in Yellow
> Dim Cell As Range
> Dim Cell_Range As Range
> Dim MyCollection As New Collection
>
> 'Find last cell entry in the row
> LastEntry = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Address
> 'Define the range to examine
> Set Cell_Range = ActiveSheet.Range("B1", LastEntry)
>
> For Each Cell In Cell_Range
> On Error Resume Next
> MyCollection.Add Item:="1", Key:=Cell.Text
> If Err.Number = 457 Then
> Cell.Interior.ColorIndex = 6
> Err.Clear
> End If
> Next Cell
>
> End Sub
>
> --------------------
>
>
> Sincerely,
> Leith Ross
>
>
> --
> Leith Ross
> ------------------------------------------------------------------------
> Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
> View this thread: http://www.excelforum.com/showthread...hreadid=557160
>
>