Here's the Excel Dupes function from a previous post with some extra features to identify the desired column and a simple GUI. I'm am currently working on code to get this deployed as an Excel add-in invoked by a ribbon button and will post a follow-up when that's complete. In the mean time, this is the code and can be wired to buttons from inside the VBA developer tools:
Private Sub CommandButton1_Click()
If Len(TextBox_Column.Value) > 0 Then
Dim column As String
column = Left(TextBox_Column.Value, 1)
HighlightDupes (column)
Else
MsgBox "You must identify a column.", vbInformation, "No column identified"
End If
End Sub
Sub HighlightDupes(column As String)
LastVal = ""
Dim sh, c, r, ltr
Dim cId As Long
cId = 0
Set sh = ActiveSheet
'Get column letter
For Each c In sh.Columns
cId = cId + 1
ltr = Col_Letter(cId)
If LCase(ltr) Like LCase(column) Then
Exit For
End If
Next c
'Sort extended column
Dim lastRow, rowKey, lastColLtr
Dim colCount As Long
Dim hasHeader As Boolean
lastRow = sh.Cells(sh.Rows.Count, ltr).End(xlUp).Row
colCount = CLng(sh.Columns.Count)
lastColLtr = Col_Letter(colCount)
hasHeader = CheckBox_Header.Value
If hasHeader Then
rowKey = 2
Else
rowKey = 1
End If
If lastRow <> 1 Then
'Sort
sh.Columns("A:BZ").Sort key1:=Cells(rowKey, cId), order1:=xlAscending, Header:=hasHeader
Dim tick As Integer
tick = 1
Dim colors(2) As Variant
colors(1) = RGB(255, 255, 196)
colors(2) = RGB(196, 255, 232)
'Highlight cells
For Each r In sh.Rows
If LastVal = sh.Cells(r.Row, cId).Value Then
sh.Cells(r.Row - 1, cId).Interior.Color = colors(tick)
sh.Cells(r.Row, cId).Interior.Color = colors(tick)
Else
tick = CInt(Not CBool(tick - 2)) + 2
End If
LastVal = sh.Cells(r.Row, cId).Value
If sh.Cells(r.Row, cId).Value = "" Then
Exit For
End If
Next r
End If
End Sub
' This function comes from Stack Overflow, thank you internet community.
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function