Find Duplicate with 2 criteria My code below find the duplicates based on 2 criteria:


The first criteria is the Name in Column A
The second criteria is the Country in Column D


Sheet("RawData") :



Sheets("Conso") after the macro:



What I am looking is to increase the speed of this code, because I am working with more than 150K rows and it takes hours.

Sub MDMDuplicates()

Dim WB As Workbook
Dim wsRawData As Worksheet, wsConso As Worksheet
Dim i As Long, j As Long, Lastrow As Long, LastrowConso as Long
Dim SupNameToCheck As String, ConsoSupplierDUNS As String, ConsoSupplierMDM As String, ConsoSupplierNAME As String



Set WB = ThisWorkbook
Set wsRawData = WB.Sheets("RawData")
Set wsConso = WB.Sheets("Conso")

Lastrow = wsRawData.Range("A" &amp; Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
With wsRawData

For i = 2 To Lastrow

SupNameToCheck = .Cells(i, "A").Value
SupCountryToCheck = .Cells(i, "D")
ConsoSupplierDUNS = ""
ConsoSupplierMDM = ""
ConsoSupplierNAME = ""


j = Lastrow
    Do
        If i &lt;&gt; j And SupNameToCheck = .Cells(j, "A") And SupCountryToCheck = .Cells(j, "D") Then

            If ConsoSupplierNAME = "" Then

            ConsoSupplierDUNS = .Cells(i, "B") &amp; "," &amp; .Cells(j, "B")
            ConsoSupplierMDM = .Cells(i, "C") &amp; "," &amp; .Cells(j, "C")
            ConsoSupplierNAME = SupNameToCheck &amp; "," &amp; .Cells(j, "A")

            Else

            ConsoSupplierDUNS = .Cells(j, "B") &amp; "," &amp; ConsoSupplierDUNS
            ConsoSupplierMDM = .Cells(j, "C") &amp; "," &amp; ConsoSupplierMDM
            ConsoSupplierNAME = .Cells(j, "A") &amp; "," &amp; ConsoSupplierNAME

            End If

           .Cells(j, "A").EntireRow.Delete

        End If

        j = j - 1

      Loop Until j = 1


LastrowConso = wsConso.Range("A" &amp; Rows.Count).End(xlUp).Row + 1
If Not ConsoSupplierNAME = "" Then
        wsConso.Cells(LastrowConso, "B") = ConsoSupplierDUNS
        wsConso.Cells(LastrowConso, "C") = ConsoSupplierMDM
        wsConso.Cells(LastrowConso, "A") = ConsoSupplierNAME
    Else
        wsConso.Cells(LastrowConso, "B") = .Cells(i, "B")
        wsConso.Cells(LastrowConso, "C") = .Cells(i, "C")
        wsConso.Cells(LastrowConso, "A") = SupNameToCheck
 End If

Next i
Application.ScreenUpdating = True

End With
End Sub
The first thing to do before making any changes to this code, is to improve its readability. I saw .Cells and thought "oh we're in a With block" ...and then had to look three times to find the With statement.

The keyword here, is indentation.

Sub DoSomething()
....
....With SomeObject
....|...
....|...If SomeCondition Then
....|...|...DoActionOne
....|...Else
....|...|...DoActionTwo
....|...End If
....|...
....|...Do
....|...|...DoActionThree
....|...Loop
....|...
....End With
....
....For i = 1 To 10
....|....
....|....DoActionFour
....|....
....Next
....
End Sub


When the Else blocks don't line up with the corresponding If statement, or when a Loop keyword doesn't line up with its corresponding Do keyword, or when nested blocks line up in column 1, you basically set yourself up for making a change that introduces a bug.

Proper indentation cannot be underestimated.



You have redundant object references:


If WB.Sheets("RawData") has CodeName Sheet1, name it RawDataSheet and use that reference instead.
If WB.Sheets("Conso") has CodeName Sheet2, name it ConsoSheet and use that reference instead.


"CodeName" is a property of all sheet objects in Excel VBA; there's a global object reference pointing to these, readily available for you to use - no need to fetch it from WB.Sheets collection, which by the way could give you non-worksheet objects, since the Sheets collection includes Charts, among other sheet types. You probably meant to use the WB.Worksheets collection instead. But then again, you don't need it - just use the global object VBA gives you for free instead.




Application.ScreenUpdating = False



Whenever you set that value to False, you need to handle runtime errors and make sure that whatever happens, the method can't exit without setting it back to True. Otherwise Excel will look "frozen" when it's actually completely responsive, just not redrawing itself... because you told it not to.

Don't assume things won't blow up. They always do.

Sub DoSomething()

    On Error GoTo CleanFail

    Application.ScreenUpdating = False

    '...

CleanExit:
    Application.ScreenUpdating = True
    Exit Sub
CleanFail:
    'handle errors
    Resume CleanExit
End Sub


Now that's great, but you're deleting rows, which should trigger a recalculation if calculation is set to xlAutomatic. Consider not only turning off ScreenUpdating, but also setting Calculation to xlManual while you're doing your thing.