HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Find Duplicate with 2 criteria

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
withduplicatecriteriafind

Problem

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" & 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 <> j And SupNameToCheck = .Cells(j, "A") And SupCountryToCheck = .Cells(j, "D") Then

If ConsoSupplierNAME = "" Then

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

Else

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

End If

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

End If

j = j - 1

Loop Until j = 1

LastrowConso = wsConso.Range("A" & 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

Solution

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.

Code Snippets

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
Application.ScreenUpdating = False
Sub DoSomething()

    On Error GoTo CleanFail

    Application.ScreenUpdating = False

    '...

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

Context

StackExchange Code Review Q#120281, answer score: 3

Revisions (0)

No revisions yet.