Highlight duplicate rows on the spreadsheet

[Apple08]

Hi All

Please I have a spreadsheet with Columns A to AE, I need to find out the duplicate rows if the cells in columns B, C, D and F are matched with another row. I expect those duplicate rows should be highlighted in cell column A (not the whole row) for checking.

The spreadsheet has unknown total number of rows.

Please could anyone give me an idea how to create this macro? Many thanks.

 

[Mposwal]

May be this could help:

Sub chkDup()


Dim i As Long, j As Long
Dim lRow As Long
lRow = Sheets(2).Cells(Rows.Count, "B").End(xlUp).Row 'finding last row
For i = 1 To lRow
For j = i + 1 To lRow
If Cells(j, "B") = Cells(i, "B") And Cells(j, "C") = Cells(i, "C") And _
Cells(j, "D") = Cells(i, "D") And Cells(j, "F") = Cells(i, "F") Then
Cells(i, "A").Value = "DUPLICATE"
Else
End If
Next j
Next i

End Sub

 

[Apple08]

Thanks Mposwal.

I have modified it to the below so as to highlight the cell in A rather than change it to 'Duplicate'. However, it didn't pick up any duplicate rows, I wonder have I done anything wrong?

Sub Find_Duplicates()


Dim i As Long, j As Long
Dim lRow As Long
lRow = Sheets("Project").Cells(Rows.Count, "A").End(xlUp).Row 'finding last row
For i = 1 To lRow
For j = i + 1 To lRow
If Cells(j, "B") = Cells(i, "B") And Cells(j, "C") = Cells(i, "C") And _
Cells(j, "D") = Cells(i, "D") And Cells(j, "F") = Cells(i, "F") Then
Cells(i, "A").Interior.ColorIndex = 6

Else
End If
Next j
Next i

End Sub

 

[Mposwal]

It seems you have blank values under column A. Replace 'Rows.Count, "A")' with 'Rows.Count, "B")' or C, D F with do have values

 

[Mposwal]

Here is my code with updated one line to color all duplicate rows:

Sub Find_Duplicates()


Dim i As Long, j As Long
Dim lRow As Long
lRow = Sheets("Project").Cells(Rows.Count, "B").End(xlUp).Row 'finding last row
MsgBox lRow
For i = 1 To lRow
For j = i + 1 To lRow
If Cells(j, "B") = Cells(i, "B") And Cells(j, "C") = Cells(i, "C") And _
Cells(j, "D") = Cells(i, "D") And Cells(j, "F") = Cells(i, "F") Then
Cells(i, "A").Interior.ColorIndex = 6
Cells(j, "A").Interior.ColorIndex = 6
End If
Next j
Next i

End Sub

 

[Apple08]

It works perfectly! Many thanks.

The spreadsheet is big with more than 11000 rows, the macro took more than an hour to run. I wonder is there any way to speed up the macro running time please?

 

[igold]

Perhaps this may be faster. It will only highlight the duplicate row, not the original and the duplicate...

Sub Find_Duplicates()

    Dim arr, i As Long, lRow As Long
    
    Application.ScreenUpdating = False
    lRow = Sheets("Project").Cells(Rows.Count, "B").End(xlUp).Row   'finding last row
    arr = Range("A2:F" & lRow)
    For i = 1 To lRow - 1
        arr(i, 1) = arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6)
    Next
    Range("A2").Resize(UBound(arr, 1)) = arr
    Range("A2:A" & lRow).Interior.ColorIndex = 6
    Range("A2:A" & lRow).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Range("A2:A" & lRow).Interior.ColorIndex = -4142
    ActiveSheet.ShowAllData
    Range("A2:A" & lRow).ClearContents
    Application.ScreenUpdating = True
        
End Sub

 

[Apple08]

Thanks igold, I will try later.

 

[Apple08]

Hi igold

There is runtime error 1004 - ShowAllData method of worksheet class failed:

 ActiveSheet.ShowAllData

 

[Sanjeev1976]

Change the line :

ActiveSheet.ShowAllData

with

If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData