Excel VBA Random Coloring The Duplicate Values

Excel VBA Grouping And Coloring

       

          Sample workbook contains two sheet and different two example macro.Dictionary Collection Object was used in each two macro - Set Evn = CreateObject("Scripting.Dictionary") -

➥ In first example(Example1 Sheet) ago,the used range columns are sorted ascending according to cell A2 .The used codes :

ActiveSheet.Cells(2, Cells(Rows.Count, lst_column).End(xlUp).Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom 

Later duplicate values background are filled by same color (according to the desired colors) . Color index number can be selected between 1 to 56. This numbers are assigned to array :

Set Evn = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        If Not Evn.exists(Cells(i, 1).Value) Then
Colors = Array(2, 4, 6, 7, 8, 12, 15, 16, 17, 19, 20, 22,24, 27, 28, 33, 34, 35, 36, 37, 38, 39, 42, 43, 44, 45, 46, 48)
Clr = Colors(Int((UBound(Colors) - LBound(Colors) + 1) * Rnd))
 Range(Cells(i, 1), Cells(i, lst_column)).Interior.ColorIndex = Clr
            Evn.Add Cells(i, 1).Value, 1
                Else
            Range(Cells(i, 1), Cells(i, lst_column)).Interior.ColorIndex = Clr
        End If
Next i

➥ In second example(Example2 Sheet) , only duplicate values' background in Column A are filled by same color . Unique value's background color doesn't change (white color).