Find duplicates in a list and hightlight with color either row or cells


New Member
Oct 30, 2011
Dear All,

Could you provide me with some help for the following problem.

I have a list of about 500 Items in a particular column let's say A. What I want is a Macro to identify duplicates in the list and highlight in a particular colour the whole row of all occurances of the same ITEM. Obviously there may be different sets of duplicates and therefore to distinguish them I need a different colour for each set. I also want a check to verify that all items have a character length of 12 and if not highlights the particular cells in 1 single character for all. Could you please help me?

Thanks and Regards.

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Do you really need a different colour for each pair ?
Worst case is that your data consists of 250 pairs, so 250 different colours, and I would guess it's going to be difficult to visually match through 250 different colours.

If you want to identify pairs of duplicates, there are probably better ways of doing it.
How about just sorting your data using col A as the primary sort field ?
Then use a helper column to identify your duplicates, such as
If the current sequence is important, insert another helper column before you do the sortation, and in this column insert an index number which will allow you to re-sort afterwards.
Upvote 0
I want to limit user intervention as possible...... What I want is that as soon as the user opens the file.... the sorting, cell text length and duplicates are already identified and easily marked for the user in such away to save time by query immediately the problems identified........... the if statement won't do the job for me................ I would like an iteration process to check the complete list for duplicates and text length.....
Upvote 0
Ah, some additional requirements . . . . :)

Well, you could apply my solution through an auto-execute macro.

It would probably help if you can describe your requirements really clearly please.
Upvote 0

I have a list of codes made up of alphanumeric characters sometimes of 500, 600, 700, depending on the shop reporting these items. Obviously each row contains first of all the ITEM CODE and then additional details in the following columns.

Now what I want is first of all to check each ITEM code to see whether it contains 12 characters. If not the particular ITEM CELL is highlighted in yellow. Then what I want is to highlight those entire rows which are duplicates. Each pair is to be highlighted in a random colour as long as pairs have the same colour. There will not be a lot, maybe 4 to 5 duplicate item codes so there will not be the problem you mentioned of a huge number of colours.

Would you be guide me through a code snippet/macro capable of doing so please?

Thanks & Regards
Upvote 0
Hi ,

Interesting concept!!

Try this - just change the setting of the 'rngMyData' variable to suit, if need be:

Option Explicit
Sub Macro1()


    Dim objUniqueItems As Object
    Dim varUniqueItem As Variant
    Dim rngCell As Range, _
        rngMyData As Range, _
        rngFoundCell As Range, _
        rngLastCell As Range
    Dim strFirstAddr As String
    Dim bteRed As Byte, _
        bteGreen As Byte, _
        bteBlue As Byte
    Application.ScreenUpdating = True
    Set objUniqueItems = CreateObject("Scripting.Dictionary")
    Set rngMyData = ActiveSheet.Range("A2:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row) 'Range A2:A[last row in Col A]. Change to suit.
    Randomize 'Without this, the RGB numbers will always be displayed in the same order.
    With ActiveSheet
        For Each rngCell In rngMyData
            If Len(rngCell.Value) > 0 Then
                If Not objUniqueItems.Exists(rngCell.Value) Then
                    objUniqueItems.Add rngCell.Value, rngCell.Value
                End If
            End If
        Next rngCell
        For Each varUniqueItem In objUniqueItems.keys
            'Randomly select a number from 0 to 255 (inclusive) for the 3 colour variables.
            bteRed = Int(255 + 1) * Rnd()
            bteGreen = Int(255 + 1) * Rnd()
            bteBlue = Int(255 + 1) * Rnd()
            'The following is based on C. Pearson's code from here: _
            With rngMyData
                Set rngLastCell = .Cells(.Cells.Count)
            End With
            Set rngFoundCell = rngMyData.Find(what:=varUniqueItem, after:=rngLastCell)
            If Not rngFoundCell Is Nothing Then
                strFirstAddr = rngFoundCell.Address
            End If
            Do Until rngFoundCell Is Nothing
                rngFoundCell.Interior.Color = RGB(bteRed, bteGreen, bteBlue)
                Set rngFoundCell = rngMyData.FindNext(after:=rngFoundCell)
                If rngFoundCell.Address = strFirstAddr Then
                    Exit Do
                End If
        Next varUniqueItem
    End With
    Application.ScreenUpdating = False
    Set objUniqueItems = Nothing
    Set rngMyData = Nothing
    Set rngFoundCell = Nothing
    Set rngLastCell = Nothing
End Sub


Upvote 0
Hi.... first of all thanks for the code....

So...the code you have given me partly works greatly because it highlights same codes with same colour, although only the CELL not the entire ROW is being highlighted in colour.

On the other hand though, I do not want non duplicates to be highlighted and the code is highlighting them as well.

Moreover, I want also that the routine checks and highlights CELLS of those codes which are less than 12 characters in YELLOW and currently the code is not doing so...

Thanks and regards.
Upvote 0
Try this :-
Sometime, if there's enough data these colours will duplicate or the array might have duplicate colour already, if I've not been diligent !!
[COLOR="Navy"]Sub[/COLOR] MG08Nov44
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Cols [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Rng.EntireRow.Interior.ColorIndex = xlNone
Cols = Array(6, 3, 4, 7, 15, 16, 17, 19, 22, 24, 28, 31, 33, 34, 35, 36, 37, 38, 39, 40, 42, 43, 44, 45, 46, 47, 48, 50)
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            n = IIf(n = UBound(Cols), 1, n)
            .Add Dn.Value, Array(Dn, Cols(n))
            .Item(Dn.Value)(0).EntireRow.Interior.ColorIndex = .Item(Dn.Value)(1)
            Dn.EntireRow.Interior.ColorIndex = .Item(Dn.Value)(1)
            [COLOR="Navy"]If[/COLOR] Len(Dn) < 12 [COLOR="Navy"]Then[/COLOR]
                Dn.Interior.ColorIndex = 6
                .Item(Dn.Value)(0).Interior.ColorIndex = 6
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
Upvote 0
Hi Mick,

Thanks for your feedback. The issue is that the code does not seem to be working as nothing is happening.......... I have duplicates and codes with less than 12 characters and nothing is being highlighted....

Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back