I got a table and want to compare all rows among themselves. If any 2 or more rows contain same values on 7 of their columns then the second (and all subsequent) duplicates are to be formatted. I wrote the following code but it does not work well....
1. it only works when there are not empty rows in my table (ie. if I have the same row multiple times but with empty rows in between, the program does not format the duplicates)
2. the program only applies format to the 3rd duplicate row and leaves first and second untouched.
Could somebody offer comments?
ps. image with the excel table has been attached
Sub Find_duplicate_rows_and_apply_format() 'The purpose is to compare all rows. if duplicates are found then 'the second (and all subsequent) row will be formated Dim X As Long Dim Y As Long Dim lrow As Long 'Deactivating all active filters. 'AutoFilterMode will be True if engaged, regardless of whether 'there is actually a filter applied to a specific column or not. 'When this happens, ActiveSheet.ShowAllData will still run, 'throwing an error (because there is no actual filtering). Range("A1").Select If ActiveSheet.AutoFilterMode = True Then Selection.AutoFilter End If If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData End If 'Find the last used row lrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'outer loop For X = 1 To lrow 'skiping empty rows If Cells(X, 1).Value = "" Then X = X + 1 Else 'inner loop For Y = X + 1 To lrow 'skip empty rows If Cells(Y, 1).Value = "" Then Y = Y + 1 Else 'Test for duplicates: 'If the values on several columns match in two rows 'format the second row of the pair, otherwise go to the next row until the end If (Cells(X, 2).Value = Cells(Y, 2).Value) And (Cells(X, 3).Value = Cells(Y, 3).Value) _ And (Cells(X, 4).Value = Cells(Y, 4).Value) And (Cells(X, 5).Value = Cells(Y, 5).Value) _ And (Cells(X, 6).Value = Cells(Y, 6).Value) And (Cells(X, 7).Value = Cells(Y, 7).Value) _ And (Cells(X, 10).Value = Cells(Y, 10).Value) Then 'Shade the entire row green if it's a duplicate Cells(Y, 2).EntireRow.Interior.ColorIndex = 4 Else End If End If Next Y End If Next X End Sub