Highlight Duplicate Rows - Entire Row vs Entire Row

Question

I cant believe how difficult this has been. I want to find all duplicate rows. Columns A:R, dynamic row count. I know how to delete the rows. But I just want to highlight them. My data is in a listobject (table) if that helps. NO! I do not want to use conditional formatting. I have already done that. It works. People always want examples, but I have re-written this so many times, here are the last two I have tried:

Again, my range is x.Range("A4:R380"). Looking how to identify duplicate rows as a whole; not based on a single column or value, etc. All columns in a row. Any help is appreciated. This is more of a learning experience than anything. Office 2010 and Office 2011 (Mac)

 Set rngCl = mySheet.Range("A4:R" + CStr(LastRd)) Set wf = Application.WorksheetFunction For i = 4 To LastRd Set cl = rngCl.Rows(i).EntireRow If wf.CountIf(rngCl, cl.Value) > 1 Then MsgBox "found" With cl.Interior .Pattern = xlSolid .PatternThemeColor = xlThemeColorAccent1 .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0.799981688894314 End With With cl.Font .Color = -16776961 .TintAndShade = 0 .Bold = True End With End If Next i End Sub Sub DuplicateValue() Dim Values As Range, iX As Integer 'set ranges (change the worksheets and ranges to cover where the staterooms are entered Set Values = Sheet6.Range("A4:R389") con = 0 con1 = 0 'checking on first worksheet For iX = Values.Rows.Count To 1 Step -1 If WorksheetFunction.CountIf(Values, Cells(iX, 1).Value) > 1 Then con = con + 1 'MsgBox "Stateroom " & Cells(iX, 1).Address & " has already been issued an iPad!!", vbCritical 'Cells(iX, 1).ClearContents End If If WorksheetFunction.CountIf(Values, Cells(iX, 3).Value) > 1 Then con1 = con1 + 1 'MsgBox "This iPAD has already been issued!!", vbCritical 'Cells(iX, 3).ClearContents End If Next iX MsgBox CStr(con) + ":" + CStr(con1) End Sub

Tim Williams had posted a code something ago which compared two rows. You could use that in a loop. Lemme find it... — Siddharth Rout
– Siddharth Rout, Commented Oct 30, 2013 at 7:38
@SiddharthRout: Tim's answer is pretty cool, thanks for the link. Wasn't aware of the Join/Transpose hack! — Peter Albert
– Peter Albert, Commented Oct 30, 2013 at 8:00
If I was half as smart as you two I would be rich. Both really great examples and really good learning experience. — D_M
– D_M, Commented Oct 30, 2013 at 10:40
I gave up working on the getting rich part. Too much work! ;-) — Peter Albert
– Peter Albert, Commented Oct 30, 2013 at 11:12

Peter Albert · Accepted Answer · 2013-10-30 08:00:07Z

Nice morning exercise! ;-)

Here's what I came up with:

Option Explicit Sub HighlightDuplicates() Dim colRowCount As Object Dim lo As ListObject Dim objListRow As ListRow, rngRow As Range Dim strSummary As String Set colRowCount = CreateObject("Scripting.Dictionary") Set lo = Sheet1.ListObjects(1) 'Count occurrence of unique rows For Each objListRow In lo.ListRows strSummary = GetSummary(objListRow.Range) colRowCount(strSummary) = colRowCount(strSummary) + 1 Next 'Color code rows For Each objListRow In lo.ListRows Set rngRow = objListRow.Range If colRowCout(GetSummary(rngRow)) > 1 Then rngRow.Interior.Color = RGB(255, 0, 0) Else rngRow.Interior.ColorIndex = RGB(0, 0, 0) End If Next End Sub Function GetSummary(rngRow As Range) As String GetSummary = Join(Application.Transpose(Application.Transpose( _ rngRow.Value)), vbNullChar) End Function

This will store the count of each unique row in a dictionary - and then check for each row if the count is larger than 1.

Can probably be optimized further (e.g. by storing the summary sting in an array), but should be a good start.

Collectives™ on Stack Overflow

Highlight Duplicate Rows - Entire Row vs Entire Row

1 Answer 1

Comments

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Linked

Related