Reputation: 1500
Basically I'd like to highlight all duplicate cells with duplicate values. I've used conditional formatting to do this. The twist is, I would like each different, duplicate value to be highlighted a unique color.
For example, If apple was found in three different cells, highlight them all red. If orange was found in two different cells, high them all blue etc. etc. and this will go on for hundreds of different, duplicate values... So I need it to generate slightly unique colors as well.
Any ideas? Thanks!
EDIT: I found a solution at this website: https://www.extendoffice.com/documents/excel/3772-excel-highlight-duplicate-values-in-different-colors.html although it costs money to install, this module, so if anyone has a different solution it would be greatly appreciated.
Upvotes: 1
Views: 2225
Reputation: 1
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
Found this VBA for Excel, it worked for me to organize and highlight multiple duplicates in different colors. Hope this helps.
Upvotes: 0
Reputation: 1500
I found a solution that uses KUTOOlS which can be found at the following website: https://www.extendoffice.com/documents/excel/3772-excel-highlight-duplicate-values-in-different-colors.html
Insert a module in VBA and enter the following code:
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
Then press F5 to run the module.
(NOTE: This only works with KUTOOLS installed)
Upvotes: -1