Find and highlight duplicate entries in excel

Question

I want to find duplicate rows and highlight every duplicate row with unique content separately.

As an example:

Row 1 - 'transaction $44.20'

Row 25 - 'transaction $44.20'

Row 31 - 'transaction $57.40'

Row 46 - 'transaction $57.40'

Row 54 - 'transaction $57.40'

Row 156 - 'transaction $15.90'

Row 197 - 'transaction $15.90'

As you see there are three sets of duplications - rows 1 and 25, rows 31, 46 and 54 and rows 156 and 197 while each duplicate content is unique.

I want to find and highlight all these unique, yet duplicate entries sets, each set with separate color. So rows 1,25 - one color, rows 31,46,54 - another, rows 156,197 - third and so on.

Excel's own Conditional Formatting->Highlight Cell Rules->Find Duplicates will highlight all of them with the same color. This is not what I want.

Ideas?

Solution 1: VBA / Solution 2: helper column and then conditionally format rows based on the helper column. — Ralph

Tom Sharpe Tom Sharpe · Accepted Answer · 2016-10-22T21:23:06

Thought I'd have a go at this and brush up my VBA skills a bit, although it's probably been done before.

The idea is that I'm using a dictionary to store the different transaction amounts as keys. If a key is found for a second time, then I know it's a duplicate and can highlight both the original value and the dup.

I've chosen to define a class Dictionary Entry that stores the location of the first instance of the 'key', plus a Boolean flag that tells me if it has already occurred more than once before (in which case I don't need to change the colour but will just retrieve the existing colour).

Public FirstInstance As Long, Dup As Boolean

Since there are only 56 colours in the predefined colour set, this will eventually run out of colours so I have set it to repeat the colour set if this happens, but things would get pretty confusing before then IMO

Sub HighlightDups()
Dim MyDictionary As Scripting.Dictionary
Set MyDictionary = New Scripting.Dictionary
Dim MyDictionaryEntry As DictionaryEntry
Dim MyColour, palette As Integer
Dim I, LastRow As Long
Dim contents As Single
palette = 2

With ActiveSheet
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

With MyDictionary
For i = 1 To LastRow
    contents = Cells(i, 1)
    If Not .Exists(contents) Then
        ' New key - create entry
        Set MyDictionaryEntry = New DictionaryEntry
        MyDictionaryEntry.FirstInstance = i
        .Add contents, MyDictionaryEntry
    Else
        If Not .Item(contents).Dup Then
            ' Dup not previously found - set new colour
            palette = palette + 1
            If palette > 56 Then palette = 2
            .Item(contents).Dup = True
            Cells(i, 1).Interior.ColorIndex = palette
            Cells(.Item(contents).FirstInstance, 1).Interior.ColorIndex = palette

        Else
            'Dup already found - retrieve previous colour
            MyColour = Cells(.Item(contents).FirstInstance, 1).Interior.ColorIndex
            Cells(i, 1).Interior.ColorIndex = MyColour
        End If
    End If
Next i
End With

End Sub

You may have to Google how to add a class and a dictionary in order to make this work - it's fairly straightforward though.

Find and highlight duplicate entries in excel

1 Answers