Find duplicates in a coulmn and highlight row background color with alternate color

[Samadhan Gaikwad]

1. I want to highlight cell colors of rows (text is in column "A" to "G")with same color when value in "A" column is same and want to iterate same operation for all rows & apply alternate colors.
2. Also want to change font color to Red in 2 cells (of column "F" and "G") when there is text "Files are on EMEA server" in "F" column.

 

[YasserKhalil]

try this code (It is for Mr. Jindon in the basis)

Sub ColourDuplicates()
    Dim r As Range, dic As Object, w

    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
   
    Application.ScreenUpdating = False
        With Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
            .Resize(, 8).Interior.ColorIndex = xlNone
            For Each r In .Cells
                If Not IsEmpty(r.Value) Then
                    If Not dic.Exists(r.Value) Then
                        ReDim w(1 To 2)
                        Set w(1) = r
   
                        With Application.WorksheetFunction
                            w(2) = Array(.RandBetween(0, 255), .RandBetween(0, 255), .RandBetween(0, 255))
                        End With
   
                        dic(r.Value) = w
                    Else
                        w = dic(r.Value)
                        r.Resize(, 8).Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2))
                        If Not IsEmpty(dic(r.Value)(1)) Then dic(r.Value)(1).Resize(, 8).Interior.Color = RGB(w(2)(0), w(2)(1), w(2)(2))
                        w(1) = Empty
                        dic(r.Value) = w
                    End If
                End If
            Next r
        End With
    Application.ScreenUpdating = True
End Sub

 

[vletm]

.. something like this... with those Red fonts

Sub Do_SG()
    Application.ScreenUpdating = False
    With ActiveSheet
        y_max = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:A" & y_max).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("AA1"), Unique:=True
        i_max = .Cells(.Rows.Count, 27).End(xlUp).Row
        .Range("A:G").AutoFilter
        For i = 2 To i_max
            .Range("A1:G" & y_max).AutoFilter Field:=1, Criteria1:=.Cells(i, 27)
            bg = i + 1
            If i > 52 Then i = 2
            .Range("A2:G" & y_max).Interior.ColorIndex = i + 1
        Next i
        .Range("A:G").AutoFilter
        .Range("A:G").AutoFilter
        .Range("A1:G" & y_max).AutoFilter Field:=6, Criteria1:="Files are on EMEA server"
        .Range("F2:G" & y_max).Font.ColorIndex = 3
        .Range("A:G").AutoFilter
        .Columns("AA:AA").Delete
    End With
    Application.ScreenUpdating = True
End Sub