2003 - Highlight duplicates, but leave one alone

[samboytor]

I'm looking for a way to highlight duplicate entries but I want to leave one un-highlighted. For example: if I have 5 of the same entry, 4 are highlighted.

 

[Trebor76]

Hi ,

Welcome to the MrExcel forum!!

Though this will probably not be efficient on large datasets, try the following - just change the two variables noted via 'Change to suit' to meet your needs:

Sub HighlightDups()

    'http://www.mrexcel.com/forum/showthread.php?t=558781
    
    '//Macro Purpose//
    'Hightlight duplicate entries expect the first duplicate
    
    'Declare variables
    Dim lngRowStart As Long, _
        lngRowLast As Long, _
        lngRowActive As Long
    Dim strCol As String
    Dim objDictionaryItemList As Object
                       
    'Set variables
    lngRowStart = 1 'Starting dataset row number.  Change to suit.
    strCol = "A" 'Column containing data.  Change to suit.
    
    Set objDictionaryItemList = CreateObject("Scripting.Dictionary")
    lngRowLast = Cells(Rows.Count, strCol).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    'Clear any previous cell shading
    Range(Cells(lngRowStart, strCol), Cells(lngRowLast, strCol)).Interior.ColorIndex = xlNone
            
    For lngRowActive = 1 To lngRowLast Step 1
    
        'If the cell contents are not already in the dictionary, simply add it _
        and leave the cell unshaded.
        If Not objDictionaryItemList.Exists(Trim(Cells(lngRowActive, strCol))) Then
            objDictionaryItemList.Add (Trim(Cells(lngRowActive, strCol))), lngRowActive
        'Else...
        Else
            '...highlight duplicate item green (change to suit)
            Cells(lngRowActive, strCol).Interior.Color = RGB(0, 255, 0)
        End If
    Next lngRowActive
    
    Application.ScreenUpdating = False
    
    Set objDictionaryItemList = Nothing

End Sub

Regards,

Robert

 

[samboytor]

How do I use this code?

 

[Trebor76]

How do I use this code?

I'm not sure what you mean?

It's simply a macro like you'd use any other macro. You just have to copy it into a macro module in the workbook in question, change the variables I mentioned, close the Visiual Basic Editor and run it (Alt + F8) when you need to.

 

[samboytor]

Thanks. I'm new to macros, but I got it to run.

I'd like to be able to do this across the entire sheet. How do accomplish that?

 

[Trebor76]

OK, try this (might take a while on large data sets):

Sub HighlightDups()

    'http://www.mrexcel.com/forum/showthread.php?t=558781
    
    '//Macro Purpose//
    'Hightlight duplicate entries expect the first duplicate for the _
    used range on the activesheet
    
    'Declare variables
    Dim rngMyData As Range, _
        rngCell As Range
    Dim objDictionaryItemList As Object
                           
    'Set variables
    Set rngMyData = ActiveSheet.UsedRange
    Set objDictionaryItemList = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    
    rngMyData.Interior.ColorIndex = xlNone
        
    For Each rngCell In rngMyData
        'If the cell contents are not already in the dictionary, simply add it _
        and leave the cell unshaded.
        If Not objDictionaryItemList.Exists(Trim(rngCell.Value)) Then
            objDictionaryItemList.Add (Trim(rngCell.Value)), rngCell.Row
        'Else, if there's an entry in the cell then shade it.
        ElseIf Len(rngCell.Value) > 0 Then
            '...highlight duplicate item green (change to suit)
            rngCell.Interior.Color = RGB(0, 255, 0)
        End If
        
    Next rngCell
    
    Application.ScreenUpdating = True
    
    Set objDictionaryItemList = Nothing

End Sub

HTH

Robert

 

[taurean]

If the data checking for duplicates is columnwise then it will be better to use conditional formatting than VBA.

Suppose you have data starting at Cell A2 then in Cell A3 enter following formula:

=COUNTIF($A$2:A3,A3)>1

using Format >> Conditional Formatting and the option: Formula is
set the formatting to suit. And then copy the formatting down to the last row in the column.

 

[samboytor]

Robert,

Thanks. That seems to be what I'm looking for.

Is there any way to have the macro running at all times? When I enter duplicate data it doesn't hilight until I click the play button. I'd like the duplicate data to hilight after I enter it into the cell.

 

[jasonb75]

You could use a change / calculate event to automate the process, but it would be much easier, and probably far more resource efficient to use native features of excel.

As taurean suggested in #7 it can be done in conditional formatting with 1 simple formula.

 

[samboytor]

taurean's suggestion doesn't work. If I enter duplicate data in every other row, nothing hilights.

I've used a similar formula: =COUNTIF($A$1:A1,A1)>1
but for some reason duplicate entries that are up 1 cell and to the right 1 cell don't highlight.