Find duplicates from multiple sheets in a workbook

I have a 600 000 data in one sheet. In "column I", I have phone numbers in Sheet1, sheet2, sheet3 and sheet4. I want to compare duplicates across sheets and highlight duplicate values in it.

Can anyone help me with this?

回答1:

This will highlight duplicates across sheets. You can use simple Conditional Formatting to call out duplicates on the same sheet.

Update: If each sheet has 10,000 identical rows, the macro takes 2 minutes (or 156.4063 seconds to be precise) to run with ScreenUpdating toggled off. That means 30,000 cells were highlighted on this timing test.

Option Explicit

Sub Duplicate_Digits()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("Sheet3")
Dim Numbers1, Numbers2, Numbers3, i
Dim Found As Range

Numbers1 = ws1.Range("I2:I" & ws1.Range("I" & ws1.Rows.Count).End(xlUp).Row).Value
Numbers2 = ws2.Range("I2:I" & ws2.Range("I" & ws2.Rows.Count).End(xlUp).Row).Value
Numbers3 = ws3.Range("I2:I" & ws3.Range("I" & ws3.Rows.Count).End(xlUp).Row).Value

For i = LBound(Numbers2, 1) To UBound(Numbers2, 1)
    Set Found = ws1.Range("I:I").Find(Numbers2(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers3, 1) To UBound(Numbers3, 1)
    Set Found = ws1.Range("I:I").Find(Numbers3(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers1, 1) To UBound(Numbers1, 1)
    Set Found = ws2.Range("I:I").Find(Numbers1(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers3, 1) To UBound(Numbers3, 1)
    Set Found = ws2.Range("I:I").Find(Numbers3(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers1, 1) To UBound(Numbers1, 1)
    Set Found = ws3.Range("I:I").Find(Numbers1(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers2, 1) To UBound(Numbers2, 1)
    Set Found = ws3.Range("I:I").Find(Numbers2(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

End Sub

回答2:

I'm not sure how resource intensive this will be, someone else please chime in if they think it won't work on OP's 600,000 rows.

You could use =COUNTIFS() in a helper column to flag duplicate values.

Put this formula in K1 and autofill to the bottom: