Better Solution to Identify Duplicates

[nniedzielski]

I am running this block of code to find duplicate numbers on two different worksheets, then copying the duplicates from one of the sheets and pasting it to another worksheet called Dup.

This takes an inordinate amount of time to run and often freezes and locks up, once the code has run also the worksheets stay unresponsive, like when i click on a cell it might take 6 or 7 seconds for excel to actually select the cell, its weird.

Is there a better way to run through worksheets to find duplicates? I did this code by using the recorder, and getting some help in here to clean it up:

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Dim exp As Worksheet
    Dim yc As Worksheet
    
    Set exp = Sheets("Export")
    Set yc = Sheets("Yard")
    
    With exp.Columns("B:B")
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlDuplicate
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    .FormatConditions(1).StopIfTrue = False
    End With
      
    With yc.Columns("A:A")
        .FormatConditions.AddUniqueValues
        .FormatConditions(1).DupeUnique = xlDuplicate
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    .FormatConditions(1).StopIfTrue = False
    End With
    
    With yc
        .Range("A1:F1").AutoFilter Field:=1, Criteria1:=RGB(255, _
        255, 0), Operator:=xlFilterCellColor
        .AutoFilter.Range.Copy Sheets("Dup").Range("A1")
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .Range("A1:F1").AutoFilter
    End With
    With Sheets("Dup").Range("A1:F1")
        .Font.Bold = True
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

 

[Fluff]

Do you only want to copy/delete the duplicates from the "Yard" sheet?

 

[nniedzielski]

Good question,

I need that and some sort of identifier on the Export page, but adding a fill is not a requirement, it could even be a Yes in a column labeled Dup?

I’m open to better solutions

 

[Fluff]

At the moment you are highlighting duplicates on the export sheet, but that has absolutely nothing to do with the Yard sheet, unless they are exactly the same.

 

[nniedzielski]

Both sheets have duplicates, and need to be called out. But only the yard needs to be copied and moved.

 

[Fluff]

Not sure if it will be much quicker, but you can try

Sub nniedzielski()
    Dim Yary As Variant, Nary As Variant
    Dim i As Long, r As Long
    Dim Yws As Worksheet
   
    Set Yws = Sheets("yard")
    Yary = Yws.Range("A1", Yws.Range("A" & Rows.Count).End(xlUp)).Value2
    ReDim Nary(1 To UBound(Yary))
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(Yary)
            If Not .Exists(Yary(i, 1)) Then
                .Add Yary(i, 1), Nothing
            Else
                r = r + 1
                Nary(r) = Yary(i, 1)
            End If
        Next i
    End With
    If r > 0 Then
        Yws.Range("A1:F1").AutoFilter 1, Nary, xlFilterValues
        Yws.AutoFilter.Range.Offset(1).Copy Sheets("Dup").Range("A1")
        Yws.AutoFilter.Range.Offset(1).EntireRow.Delete
        Yws.AutoFilterMode = False
    End If
    With Sheets("Export")
        With Range("B1", .Range("B" & Rows.Count).End(xlUp))
            .FormatConditions.Delete
            .FormatConditions.AddUniqueValues
            .FormatConditions(1).DupeUnique = xlDuplicate
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
            End With
        End With
    End With
End Sub

You will also need to delete all the CF rules that code has inserted.

 

[nniedzielski]

I got a run time error:

ActiveX component cant create object

As well as an error that a suspicious action was attempted with a cylance error.

any way around this?

 

[Fluff]

Are you trying to run this on a Mac?

 

[nniedzielski]

No it’s not a Mac. Windows PC

 

[Fluff]

In that case I see no reason why you would get that error.
As my code what only marginally faster than yours on some test data, I'd suggest you stick with your code, but make sure you delete all the CF rules that your code has added.
But change the two sections that apply the CF to match the way I did it.