How to highlight duplicate values in different colors in Excel?

In Excel, we can easily highlight the duplicate values in a column with one color by using the Conditional Formatting, but, sometimes, we need to highlight the duplicate values in different colors to recognize the duplicates quickly and easily as following screenshot shown. How could you solve this task in Excel?

Highlight duplicate values in a column with different colors by using VBA code

Highlight duplicate values in a column with different colors by using VBA code

In fact, there is no direct way for us to finish this job in Excel, but, the below VBA code may help you, please do as follows:

1. Select the column of values that you want to highlight duplicates with difference colors, then hold down the ALT + F11 keys to open the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following code in the Module Window.

VBA code: Highlight duplicate values in different colors:

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim I As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
      End If
      On Error GoTo 0
    Next
End Sub

3. And then press F5 key to run this code, and a prompt box will remind you to select the data range that you want to highlight the duplicate values, see screenshot:

doc different colors duplicates 2

4. Then click OK button, all the duplicate values have been highlighted in different colors, see screenshot:

doc different colors duplicates 1

The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.

Read More... Free Download... Purchase...

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
Open and create multiple documents in new tabs of the same window, rather than in new windows.
Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!

Read More... Free Download... Purchase...

Comments (88)

No ratings yet. Be the first to rate!

Edward

about 5 years ago

#17934

This comment was minimized by the moderator on the site

It worked for me on a list of part numbers.

Alex Edward

about 3 years ago

#17935

This comment was minimized by the moderator on the site

Hello,

Is there a way to make this only effect the highlighted column and not the entire row? Some of the bold red and blue colors are hard to look at all the way across the spreadsheet. Thanks

Patrick A.

about 5 years ago

#18047

This comment was minimized by the moderator on the site

This is just what I needed, thank you. Sometimes when I run this code Excel just freezes, I am using Office 2016 / Windows 10 any idea why?

Alan Patrick A.

about 5 years ago

#18048

This comment was minimized by the moderator on the site

Patrick, only highlight the cells you want. Don't highlight the entire column which will include all the thousands of blank cells

Swapnil

about 5 years ago

#18664

This comment was minimized by the moderator on the site

i want to check the duplicates for 5000 cells which i am not able to do. i can highlight duplicates upto 70 to 80 cells

JOTA475 Swapnil

about 10 months ago

#18665

This comment was minimized by the moderator on the site

Sub BuscarD()
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCol As Collection
Dim I As Long
Dim J As Integer
Dim K As Integer
Dim xCLR As Integer

xCLR = 28

On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("Seleccione el rango a evaluar:", "Buscar duplicados", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
J = 0
K = 0
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then
xCellPre.Interior.Color = RGB(255, J, K)
xCell.Interior.Color = RGB(255, J, K)
If K + xCLR <= 255 Then
K = K + xCLR
Else
If J + xCLR <= 255 Then
K = 0
J = J + xCLR
Else
MsgBox "!Demasiados datos duplicados!: Reducir variable xCLR", vbCritical, "Error"
Exit Sub
End If
End If
Else
xCell.Interior.Color = xCellPre.Interior.Color
End If
ElseIf Err.Number = 9 Then
MsgBox "Demasiados datos duplicados!", vbCritical, "Error"
Exit Sub
End If
On Error GoTo 0
Next

End Sub

Es un tema viejo, pero lo dejo por si alguien lo necesita. Con el código anterior y modificando la variable "xCLR", desde 1 a 255, se pueden obtener desde 4 hasta 65.000 colores diferentes. En mi caso, configuré el rojo del RGB con un valor estático de 255 y varío los valores verde y azul (255, X, X). Si se requieren mas colores, se podría alterar el valor del rojo, logrando mas de 166 millones de colores diferentes

Golzar

about 5 years ago

#18682

This comment was minimized by the moderator on the site

This has been a life saver for me, thank you so much for sharing! When I run it on about 2000 cells with values, it only highlights some of the duplicates. Is there a way to fix that? I wonder if it runs out of colors or there is something else.

yp Golzar

about 5 years ago

#18683

This comment was minimized by the moderator on the site

same problem i am trying with couple of hundred cells and very quickly it colors in same colors. is there a fix for this? thanks

about 5 years ago

#19329

This comment was minimized by the moderator on the site

Same problem. Anyone figure this out?

Josh

about 5 years ago

#19613

This comment was minimized by the moderator on the site

I had the same problem, the problem is the color index only goes to 56, so once it passes that it no longer colors the cells. To fix that, I replaced the line "xCIndex = xCIndex + 1" with the following: If xCIndex > 55 Then xCIndex = 3 Else xCIndex = xCIndex + 1 End If It will start reusing colors eventually, but that wasn't an issue for me.

FRANK Josh

about 5 years ago

#19614

This comment was minimized by the moderator on the site

The replace with If xCIndex > 55 Then xCIndex = 3 Else xCIndex = xCIndex + 1 End If Did not work. Trying to get this to work on 14000 lines, approx 6000 duplicates

Golzar FRANK

about 4 years ago

#19615

This comment was minimized by the moderator on the site

It worked for me, I indented the second and fourth lines. See below. Josh's code is bolded.

If Err.Number = 457 Then
If xCIndex > 55 Then
xCIndex = 3
Else
xCIndex = xCIndex + 1
End If
Set xCellPre = xCol(xCell.Text)

Golzar Josh

about 4 years ago

#19616

This comment was minimized by the moderator on the site

Thank you so much Josh, it works!

Jason

about 5 years ago

#19738

This comment was minimized by the moderator on the site

I tried running this several times and every time I click "ok" it just sends me back to the modules screen. I'm using Excel 2010.

Sarah

about 5 years ago

#19916

This comment was minimized by the moderator on the site

This is great and EXACTLY what I was looking for! I'm incorporating this code into some existing code - I've written my code to select the cells that I want to color, and then I call the code to do the coloring. The only thing I can't figure out is how to bypass the msgBox that pops up and I have to click OK. I'm a novice at VBA and can't quite figure out how to alter this code.... Any suggestions, please! :)

Wojciech Radwan Sarah

about 4 years ago

#19917

This comment was minimized by the moderator on the site

Replace line: Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
to
Set xRg = Range("A1:A100")

or if you have table you can apply to whole table column:
Set xRg = Range("Table1[[#All],[Column1]]")

just replace Table1 to your own name and Column1 to any table header you wish to apply this macro.

Regards
Wojciech

SHRIKANT NAYAK

about 5 years ago

#19995

This comment was minimized by the moderator on the site

I am really happy as I got what I was needed. Thanks

bhaggi

about 4 years ago

#22378

This comment was minimized by the moderator on the site

how to change colour ?

skyyang bhaggi

about 4 years ago

#22379

This comment was minimized by the moderator on the site

Hi，
The code only can help you add the different color randomly, it can't change the color.
Thank you!

Report

John skyyang

about 4 years ago

#22380

This comment was minimized by the moderator on the site

It seems to always use the same color palette though, is there a way to select the palette it uses? It's giving me some really dark colors through which the text is unreadable.

Edmund Pelingon bhaggi

about 4 years ago

#22381

This comment was minimized by the moderator on the site

the same problem with me... color is too dark to read...

Report

gopi

about 4 years ago

#22674

This comment was minimized by the moderator on the site

without empty to change a colour how ????????????????????

skyyang gopi

about 4 years ago

#22675

This comment was minimized by the moderator on the site

Hello, gopi,
To avoid the blank cells, please apply the following VBA code:
Sub ColorCompanyDuplicates()
'Updateby Extendoffice 20171222
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
If xCell.Value <> "" Then
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
Exit Sub
End If
On Error GoTo 0
End If
Next
End Sub

Hope it can help you, thank you!

Report

shahinshah

about 4 years ago

#23258

This comment was minimized by the moderator on the site

Sir,
How to differentiate different colors given in the data on the basis of frequency?
In very large data same color has been given repeatedly without considering their frequency.

skyyang shahinshah

about 4 years ago

#23259

This comment was minimized by the moderator on the site

Sorry, can you give more detailed information,you can attach a screenshot here.
Thank you!

Report

Asking Man

about 4 years ago

#24334

This comment was minimized by the moderator on the site

Hello, I have Excel 2016, alt+F11 does work anymore to bring up Microsoft VB? is Microsoft visual basic free software? Thank you.

skyyang Asking Man

about 4 years ago

#24335

This comment was minimized by the moderator on the site

Hi,
If you can not activate the Microsoft VB window by holding down Alt + F11 keys, you can click Developer > Visual Basic to open it.

Please try it, thank you!

View Attachments (1 / 5)

Report

selim

about 4 years ago

#24592

This comment was minimized by the moderator on the site

What If I just want to fill with only two colors, let's say yellow and red, repeatedly. To be clear, on the example in this page, 'Rachel' is yellow, Rose is red and again Sussies are yellow, Tedi is red.

skyyang selim

about 4 years ago

#24593

This comment was minimized by the moderator on the site

Hello, selim,
The following code may solve your problem, please try.

Sub ColorCompanyDuplicates()
'Updateby Extendoffice 20170504
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xRgTemp As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 3
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
Set xCellPre = xCol(xCell.Text)
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
Exit Sub
Else
xCell.Interior.ColorIndex = xCIndex
Set xRgTemp = xCell
xCIndex = IIf(xRgTemp.Interior.ColorIndex = 3, 4, 3)
End If
On Error GoTo 0
Next
End Sub

Hope it can help you!

Report

selim skyyang

about 4 years ago

#24594

This comment was minimized by the moderator on the site

This is what I exactly want it. Thank you much, skyyang.

Bobo

about 4 years ago

#24656

This comment was minimized by the moderator on the site

Is there a way to highlight the entire row instead of 1 column?

skyyang Bobo

about 4 years ago

#24657

This comment was minimized by the moderator on the site

Hi, Bobo,
To highlight entire row based on the duplicate cell values, you can apply the following VBA code:

Sub ColorCompanyDuplicates()
Dim xRg As Range
Dim xTxt As String
Dim xCell As Range
Dim xChar As String
Dim xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
On Error Resume Next
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For Each xCell In xRg
On Error Resume Next
xCol.Add xCell, xCell.Text
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xCell.Text)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.EntireRow.Interior.ColorIndex = xCIndex
xCell.EntireRow.Interior.ColorIndex = xCellPre.EntireRow.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
Exit Sub
End If
On Error GoTo 0
Next
End Sub

Please try it, hope it can help you!

Report

Hossein skyyang

about 4 years ago

#24658

This comment was minimized by the moderator on the site

how can I highlight the range of rows?

skyyang Hossein

about 4 years ago

#24659

This comment was minimized by the moderator on the site

Hello, Hossein,
May be the following code can do you a favor, please try it.

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
Dim xRg, xRgRow As Range
Dim xTxt, xStr As String
Dim xCell, xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For I = 1 To xRg.Rows.Count
On Error Resume Next
Set xRgRow = xRg.Rows(I)
For Each xCell In xRgRow.Columns
xStr = xStr & xCell.Text
Next
xCol.Add xRgRow, xStr
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xStr)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
Exit Sub
End If
On Error GoTo 0
xStr = ""
Next
End Sub

Report

Carla skyyang

about 1 week ago

#39236

This comment was minimized by the moderator on the site

Amazing!! This helped me a lot!
And if I need to highlight the single ones too? How can I do that?

skyyang Carla

about 5 days ago

#39341

This comment was minimized by the moderator on the site

Hello, Carla

To highlight the rows including the unique ones, please apply the below VBA code:

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
Dim xRg, xRgRow As Range
Dim xTxt, xStr As String
Dim xCell, xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim xOnlyIndex
Dim I As Long
If ActiveWindow.RangeSelection.Count > 1 Then
    xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
    xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For I = 1 To xRg.Rows.Count
    On Error Resume Next
    Set xRgRow = xRg.Rows(I)
    For Each xCell In xRgRow.Columns
        xStr = xStr & xCell.Text
    Next
    xCol.Add xRgRow, xStr
    If err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xStr)
        If xCellPre.Interior.ColorIndex = xlNone Then
            xCellPre.Interior.ColorIndex = xCIndex
        Else            
        End If
        xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
    ElseIf err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
    End If    
    On Error GoTo 0
    xStr = ""
Next
For Each xCellPre In xCol
    If xCellPre.Interior.ColorIndex = xlNone Then
        xCIndex = xCIndex + 1
        xCellPre.Interior.ColorIndex = xCIndex
    End If
Next
End Sub

Please try, hope it can help you!

Report

Carla skyyang

about 4 days ago

#39380

This comment was minimized by the moderator on the site

Yes skyyang! You rock! 😀
Can we highlight the entire row instead of only the column?

I'm sorry if I'm being annoyng, but you really helped me a lot!

skyyang Carla

1 day ago

#39408

This comment was minimized by the moderator on the site

Hello, Caria,
If you need to highlight the entire rows, you just need to select the entire rows range when selecting the data range in the popped out dialog box.
Please try, thank you!

Report

Vasil

about 4 years ago

#24750

This comment was minimized by the moderator on the site

Is there a way to change the script to work for (look at) table array instead of column? For example F2:BC117.
Thank you!

skyyang Vasil

about 4 years ago

#24751

This comment was minimized by the moderator on the site

Hello, Vasil,
To highlight duplicate values in a range of cell, please try the following vba code:

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
Dim xRg, xRgRow As Range
Dim xTxt, xStr As String
Dim xCell, xCellPre As Range
Dim xCIndex As Long
Dim xCol As Collection
Dim I As Long
If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If
Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
If xRg Is Nothing Then Exit Sub
xCIndex = 2
Set xCol = New Collection
For I = 1 To xRg.Rows.Count
On Error Resume Next
Set xRgRow = xRg.Rows(I)
For Each xCell In xRgRow.Columns
xStr = xStr & xCell.Text
Next
xCol.Add xRgRow, xStr
If Err.Number = 457 Then
xCIndex = xCIndex + 1
Set xCellPre = xCol(xStr)
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xRgRow.Interior.ColorIndex = xCellPre.Interior.ColorIndex
ElseIf Err.Number = 9 Then
MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
Exit Sub
End If
On Error GoTo 0
xStr = ""
Next
End Sub

Hope it can help you.

Report

Priya

about 4 years ago

#24908

This comment was minimized by the moderator on the site

I am new to VBA. Is there any way, that we need not run the macro over and over, it is automated to highlight even if new cells are copied into the column where macro is programmed?

Anri

about 4 years ago

#25302

This comment was minimized by the moderator on the site

This is really great, but colouring stopped after row 66 (9 colours). How can I this be extended?

skyyang Anri

about 4 years ago

#25303

This comment was minimized by the moderator on the site

Hello, Anri,
The above code works well in my worksheet, i test it in 300 hundred rows.
Please try it again. Or you can send your workbook file to my email account.
My email account is: skyyang@extendoffice.com

Report

Bruce luo skyyang

about 3 years ago

#25304

This comment was minimized by the moderator on the site

there is some mistake regarding the colorindex setting, xCindex will be more than 56 if there are 56 row data in your sheet, system will ignore the sentence :
If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
I correct the program like below: \
if Err.number=457 then
if xCellPre.Text<>xCell.Text Then
xCindex=xCindex+1
endif
set.....

Report

Ahmed skyyang

about 3 years ago

#25305

This comment was minimized by the moderator on the site

Hello,
my excel sheet has 11000 row of data.
how can I extend it to highlight all the duplicate in that long column.

it stopped at row 77.

Thanks,

AK