Highlight duplicates with only 2 colors

0 votes

Each set of duplicates either shows with light yellow or dark

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

In order to distinguish between duplicates or the group of duplicates, I want the above code to be limited to just two colours: light yellow and dark yellow.

To distinguish between the repeated data, I attempted to limit the above VBA code restriction to just two colours, but I'm not sure how to do so.

Mar 27, 2023 in Others by Kithuzzz
• 38,000 points
426 views

1 answer to this question.

0 votes

Try this:

Sub ColorCompanyDuplicates2()
'best practice to define all variables / but cbb tbh 💪🏼
k = 0
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
End If
xCIndex = 27
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
        If Range("b2").Value = "Y" Then
            If xCIndex = 19 Then
                xCIndex = 27
            Else: xCIndex = 19
            End If
        Else
            k = k + 1
            If k = 1 Then
                go_back1 = xCellPre
            ElseIf k = 2 Then
                go_back2 = xCellPre
            Else
                xCIndex = 27
                go_back1.Interior.ColorIndex = xCIndex
                go_back2.Interior.ColorIndex = xCIndex
            End If
        End If
'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
answered Mar 27, 2023 by narikkadan
• 63,600 points

Related Questions In Others

0 votes
0 answers
0 votes
1 answer

It shows black screen when trying to load Map on device with ionic 2 Google Map Native plugin

In order to answer your question, start ...READ MORE

answered Feb 8, 2022 in Others by Rahul
• 9,680 points
1,754 views
0 votes
1 answer

Invoke-customs are only supported starting with android 0 --min-api 26

After hours of working on this probleme, ...READ MORE

answered Feb 16, 2022 in Others by Soham
• 9,710 points
3,355 views
0 votes
0 answers

Excel: Highlighting duplicates with exact matches

1 I've got two columns of data, and ...READ MORE

Feb 17, 2022 in Others by Edureka
• 13,690 points
461 views
0 votes
1 answer

In =RTD(ProgID,Server,String1,[String2],...), passing array for String2, String3 and so on

Since WorksheetFunction.RTD() method (https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.rtd) signature (i.e.: how many parameters it is ...READ MORE

answered Jan 23, 2023 in Others by narikkadan
• 63,600 points
410 views
0 votes
0 answers

Convert Rows to Columns with values in Excel using custom format

1 I having a Excel sheet with 1 ...READ MORE

Feb 17, 2022 in Others by Edureka
• 13,690 points
975 views
0 votes
1 answer

Remove formulas from all worksheets in Excel using VBA

Try this : Option Explicit Sub test1() ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,600 points
2,019 views
0 votes
1 answer

Calculate monthly average from daily data without PivotTable

Assuming you have the months in column D enter ...READ MORE

answered Oct 3, 2022 in Others by narikkadan
• 63,600 points
1,762 views
0 votes
1 answer

How to sum the value of 2 rows with vlookup by only using 1 formula?

 Try in Excel Online: • Formula used in cell C3 =SUM(SCAN(0,M3:N3,LAMBDA(x,y,VLOOKUP(y,P3:Q12,2,0)))) Works ...READ MORE

answered Jan 17, 2023 in Others by narikkadan
• 63,600 points
516 views
0 votes
1 answer

How implement SEO (Metatags) in Angular 2 (with Angular universal for rendering on server side)?

https://github.com/angular/universal-starter follow this repo among it there ...READ MORE

answered Feb 22, 2022 in Others by narikkadan
• 63,600 points
1,110 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP