Macro to find duplicates rows - excel

Question

I am looking for a macro to find duplicate rows in a spreadsheet. So far I have come up with this set of code:
Application.ScreenUpdating = False
For Each cell In ActiveSheet.UsedRange.Columns("A").Cells
For Each cell2 In ActiveSheet.UsedRange.Columns("A").Cells 'Loop through entire column A for each iteration in nested for loop
If Cells(y, 1).Value = Cells(z, 1).Value Then 'Duplicate value found
For icol = 1 To 19
If Cells(y, icol).Value = Cells(z, icol).Value Then 'If cell value in current row matches, highlight red
Cells(z, icol).Interior.ColorIndex = 3
End If
Next icol
End If
z = z + 1
Next cell2
y = y + 1 'Next cell
z = y + 1 'Next cell (y+1)
Next cell
Application.ScreenUpdating = True
I have approached this with nested foor loops. The macro is supposed to look for a duplicate value in column A. If found the macro then loops through that row to check if the entire row matches. Every matching cell in this row is then highlighted red. This seems to work fine in small scale when the number of rows isn't too big. However when applying this macro to a spreadsheet with 7000+ rows Excel freeze up and crashes. I suspect this has to do with the nested foor loops. Is there a faster and more practical approach to this?

Answer 1

Try conditional formatting instead of hard-coding the red cell fills.
Option Explicit
Sub dupeRed()
Dim lr As Long, lc As Long
With Worksheets("sheet1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
With .Range(.Cells(2, "A"), .Cells(lr, lc))
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=AND(COUNTIF($A$1:$A1, $A2), A2=INDEX(A:A, MATCH($A2, $A:$A, 0)))"
.FormatConditions(.FormatConditions.Count).Interior.Color = vbRed
End With
End With
End Sub