Tip: Other languages are Google-Translated. You can visit the English version of this link.
Log in
x
or
x
x
Register
x

or

How to highlight duplicate values in different colors in Excel?

doc different colors duplicates 1

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


arrow blue right bubble 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 20160704
    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


Recommended Productivity Tools

Ribbon of Excel (with Kutools for Excel installed)

300+ Advanced Features Increase Your Productivity by 71%, and Help You To Stand Out From Crowd!

Would you like to complete your daily work quickly and perfectly? Kutools For Excel brings 300+ cool and powerful advanced features (Combine workbooks, sum by color, split cell contents, convert date, and so on...) for 1500+ work scenarios, helps you solve 82% Excel problems.

  •  Deal with all complicated tasks in seconds, help to enhance your work ability, get success from the fierce competition, and never worry about being fired.
  •  Save a lot of work time, leave much time for you to love and care the family and enjoy a comfortable life now.
  •  Reduce thousands of keyboard and mouse clicks every day, relieve your tired eyes and hands, and give you a healthy body.
  •  Become an Excel expert in 3 minutes, and get admiring glance from your colleagues or friends.
  •  No longer need to remember any painful formulas and VBA codes, have a relaxing and pleasant mind, give you a thrill you've never had before.
  •  Spend only $39, but worth than $4000 training of others. Being used by 110,000 elites and 300+ well-known companies.
  •  60-day unlimited free trial. 60-day money back guarantee. Free upgrade and support for 2 years. Buy once, use forever.
  •  Change the way you work now, and give you a better life immediately!

Office Tab Brings Efficient And Handy Tabs to Office (include Excel), Just Like Chrome, Firefox, And New IE

  • Increases your productivity by 50% when viewing and editing multiple documents.
  • Reduce hundreds of mouse clicks for you every day, say goodbye to mouse hand.
  • Open and create documents in new tabs of same window, rather than in new windows.
  • Help you work faster and easily stand out from the crowd! One second to switch between dozens of open documents!
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    shahinshah · 1 years ago
    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.
    • To post as a guest, your comment is unpublished.
      skyyang · 1 years ago
      Sorry, can you give more detailed information,you can attach a screenshot here.
      Thank you!
  • To post as a guest, your comment is unpublished.
    gopi · 1 years ago
    without empty to change a colour how ????????????????????
    • To post as a guest, your comment is unpublished.
      skyyang · 1 years ago
      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!
  • To post as a guest, your comment is unpublished.
    bhaggi · 1 years ago
    how to change colour ?
    • To post as a guest, your comment is unpublished.
      Edmund Pelingon · 1 years ago
      the same problem with me... color is too dark to read...
    • To post as a guest, your comment is unpublished.
      skyyang · 1 years ago
      Hi,
      The code only can help you add the different color randomly, it can't change the color.
      Thank you!
      • To post as a guest, your comment is unpublished.
        John · 1 years ago
        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.
  • To post as a guest, your comment is unpublished.
    SHRIKANT NAYAK · 1 years ago
    I am really happy as I got what I was needed. Thanks
  • To post as a guest, your comment is unpublished.
    Sarah · 1 years ago
    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! :)
    • To post as a guest, your comment is unpublished.
      Wojciech Radwan · 10 months ago
      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