Excel - Colour duplicates

Doing data analysis, finding when you have repeats in a data-set is a really common task - particularly when you are exploring the data-set to get a sense for what might be there. This macro takes the record block you currently have your active cell in, and then does alternate colours across the block each time it finds a change of data in the current column. Here's an example to help you visualize. This list is sorted in the right-hand column and unsorted in the left.

As the Active Cell is in the left column, the macro looks for changes in groups there. On each change of type, the colour changes.

Now that wasn't much use - but if we sort the "type" column and apply the macro:

You can see that the groups are now visually defined by the colours.

Sub Colour_groups()
'Andrew Cave andrew.cave.blogging at gmail 2014
'**colors a spreadsheet row according to whether the PREVIOUS cell in the activecell column
'   matches it or not
'** if no match colors the cell to a different colour.
'**Gets width of colour block from rightmost cell in Row 1

Dim i As Long
Dim rg As Range
Dim c As Range, lastCell As Range
Dim rg2 As Range
Dim row As Long
Dim rowChange As Range
Dim groupCount As Long
Dim col As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim strActiveColumn As String
Dim intActiveColumn As Long
Dim darkColour As Long
Dim darkColour2 As Long
Dim lightColour As Long
Dim prevValue As Variant

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

'51 = xlOpenXMLWorkbook (without macro's in 2007-2010, xlsx)
'52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2010, xlsm)
'50 = xlExcel12 (Excel Binary Workbook in 2007-2010 with or without macro's, xlsb)
'56 = xlExcel8 (97-2003 format in Excel 2007-2010, xls)

col = ws.Range(IIf(wb.FileFormat = 56, "iv1", "xfd1")).End(xlToLeft).Column 'rightmost cell on the sheet - move left to find edge of data
intActiveColumn = ActiveCell.Column
'build the column letter names up

i = Int(Log(intActiveColumn) / Log(26)) 'get log base 26 (so we know how long the column name will be
'get the string name of the column (A,B...AB...IV etc)
Do
  If i > 0 Then
    strActiveColumn = strActiveColumn & Chr(intActiveColumn \ (26 ^ i) + 64)
  Else
    strActiveColumn = strActiveColumn & Chr(intActiveColumn + 64)
  End If
  intActiveColumn = intActiveColumn Mod (26 ^ i)
  i = i - 1
Loop While i >= 0
' reset values
i = 0
intActiveColumn = ActiveCell.Column
row = ws.Cells(IIf(wb.FileFormat = 56, 65536, 2 ^ 20), ActiveCell.Column).End(xlUp).row
row = ws.Cells(IIf(wb.FileFormat = 56, 65536, 2 ^ 20), ActiveCell.Column).End(xlUp).row

darkColour = 35
darkColour2 = 44
lightColour = 0

Set rg = ws.Range(strActiveColumn & "2:" & strActiveColumn & row)

Set rowChange = rg.Cells(1, 1)
For Each c In rg
    If c.Value = rowChange.Value Then 'are we in a group?
        groupCount = groupCount + 1 'count rows in group
    Else
        'and blank the current row
        If i Mod 3 = 0 Then
            Range(c.Offset(0 - groupCount, 1 - intActiveColumn), c.Offset(-1, col - intActiveColumn)).Interior.ColorIndex = darkColour
        ElseIf i Mod 3 = 1 Then
            Range(c.Offset(0 - groupCount, 1 - intActiveColumn), c.Offset(-1, col - intActiveColumn)).Interior.ColorIndex = darkColour2
        Else
            Range(c.Offset(0 - groupCount, 1 - intActiveColumn), c.Offset(-1, col - intActiveColumn)).Interior.ColorIndex = lightColour
        End If
        i = i + 1
        groupCount = 1
        Set rowChange = c ' keep a reference to the (potential) first row of the group
    End If
    Set lastCell = c
Next c
If groupCount > 1 Then 'handle the last row being part of a group
        If i Mod 3 = 0 Then
            Range(lastCell.Offset(1 - groupCount, 1 - intActiveColumn), lastCell.Offset(0, col - intActiveColumn)).Interior.ColorIndex = darkColour
        ElseIf i Mod 3 = 1 Then
            Range(lastCell.Offset(1 - groupCount, 1 - intActiveColumn), lastCell.Offset(0, col - intActiveColumn)).Interior.ColorIndex = darkColour2
        Else
            Range(lastCell.Offset(1 - groupCount, 1 - intActiveColumn), lastCell.Offset(0, col - intActiveColumn)).Interior.ColorIndex = lightColour
        End If
Else 'colour the last row if it is not in a group
    Range(Cells(lastCell.row, 1), Cells(lastCell.row, col)).Interior.ColorIndex = IIf(i Mod 3 = 0, darkColour, IIf(i Mod 3 = 1, darkColour2, lightColour))
    
End If

'handle the end of the lists -- ie if last one is a duplicate
Set ws = Nothing: Set wb = Nothing

End Sub