Find Duplicates with 2 conditions

Hi ALL,

I have thought of finding alternatives to above problem. Is there any way to find Duplicates of column "M" in sheet "POData" based on matching fields in I & N? I want macro to pop up the cells for correction by user. If user don't correct data, macro run should stop prompting message to correct data.

Look forward for your advise.

Best Regards,

Narasimharao

Hi Narasimharao,

Your column M is the expected invoice value and you want to find duplicate base on the value? any other unique column you can use, such as Invoice number/ PO number or else?


The formula I use would be :

Formula:

Cell N5

"=IF(COUNTIF(M:M,M5)>1,"Duplicate","")"

Cheers,
Lex

Hi Lexusap,

Thank you for your reply to my query. is there any way to transfer data of respective rows of columns "I" (PO Number) and "M" (expected invoice value) to different sheet when "duplicate" found? Once duplicates found, i want to stop further execution of other macro codes. New sheet name can be "Duplicates".

Thanks once again for your help and reply.

Best Regards,
Narasimharao

Hi,

I have added another sheet named 'duplicate' and click the button to check any duplicate.
I used the purchase order number as the unique code.

Cheers
Lex

Hi Lexusap,

Thank you once again for immediate reply and solution. I need one more change. Can the Countif function be changed for duplicate check of "I"&"K" together? This reduces number of lines in duplicate sheet.

Look forward for your further advise. Thanks once again.

Best Regards,

Nandula

Hi Lexusap,

I found another problem with macro run. My POData sheet contains more than 25,000 rows. Macro run with existing code that is provided by you taking almost 10 Mins to complete. I tried to modify as follows:
Kindly suggest is there any alternative.

Best Regards,
Narasimharao

Application.ScreenUpdating = False

Sheets("DuplicatesofPO").Range("a2:I2000").ClearContents

Sheets("POData").Activate

eor1 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For x = 5 To eor1 Step 1
    
    Sheets("POData").Select
    
    A = WorksheetFunction.CountIf(Range("I:I"), Range("I" & x))
       
    If A = 1 Then
        'Do nothing
    Else
    
    eor2 = Sheets("DuplicatesofPO").Cells(Rows.Count, 1).End(xlUp).Row
    Range("I" & x).Copy Sheets("DuplicatesofPO").Range("A" & eor2 + 1)
    Range("C" & x & ":H" & x).Copy Sheets("DuplicatesofPO").Range("B" & eor2 + 1)
    Range("K" & x).Copy Sheets("DuplicatesofPO").Range("I" & eor2 + 1)
    Range("J" & x).Copy Sheets("DuplicatesofPO").Range("H" & eor2 + 1)
    End If
    
Next x

Application.ScreenUpdating = True

Sheets("DuplicatesofPO").Select

MsgBox "Found Duplicate Purchase order number. Please investigate before continuing!"

Hi All,

I am still looking for help on the requirement. Meanwhile based on various inputs, i tried to find alternatives to provide solution to our users. I am enclosing revised file which includes full list of items.
Present code appended below works for me but very slow due to huge volume. So i decided to run the code only for the values which are higher than certain threshold. In my latest file, Sheet POData column "AM" contains True or False.

Now following code has to run only when the column AM has "True". Can any body help me on this?

Look forward for your kind advise.

best regards,
Narasimharao

Sheets("POData").Activate
    
    With Range("I5", Range("I" & Rows.Count).End(xlUp))
        .Offset(, 8).Value = Evaluate(.Address & "&" & .Offset(, 2).Address)
    End With

Sheets("Duplicate").Range("a10:I2000").ClearContents

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("podata").Activate

eor1 = Cells(Rows.Count, 1).End(xlUp).row

For x = 5 To eor1 Step 1
    Sheets("PODATA").Select
    
    a = WorksheetFunction.CountIf(Range("Q:Q"), Range("Q" & x))
       
    If a = 1 Then
        'Do nothing
    Else
    
    eor2 = Sheets("Duplicate").Cells(Rows.Count, 1).End(xlUp).row
    Range("I" & x).Copy Sheets("Duplicate").Range("A" & eor2 + 1)
    Range("C" & x & ":H" & x).Copy Sheets("Duplicate").Range("B" & eor2 + 1)
    Range("K" & x).Copy Sheets("Duplicate").Range("I" & eor2 + 1)
    Range("J" & x).Copy Sheets("Duplicate").Range("H" & eor2 + 1)
    End If
    
Next x

Sheets("Duplicate").Select

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "Found Duplicate Purchase order number. Please investigate before continuing!"

Narasimharao,
I have amended the code you have. I have removed some lines to speed up the code. On my PC, it took just over 31 seconds to run the code.

I perhaps could have come up with different code, but not only your request is not clear, but keep changing too. So, this code is easy to amend it your self and should stick with it.

Option Explicit
Sub Find_dup_po_number()
Dim ms As Worksheet, eor1&, eor2&, x&, dTimer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
dTimer = Timer
Set ms = Sheets("Duplicate")
ms.Range("a10:I" & Rows.Count).ClearContents

With Sheets("podata")

    eor1 = .Cells(.Rows.Count, 1).End(xlUp).row
    
    For x = 5 To eor1
           
        If WorksheetFunction.CountIf(.Range("Q:Q"), .Range("Q" & x)) > 1 Then
             eor2 = ms.Cells(Rows.Count, 1).End(xlUp).row + 1
            .Range("I" & x).Copy ms.Range("A" & eor2)
            .Range("C" & x & ":H" & x).Copy ms.Range("B" & eor2)
            .Range("K" & x).Copy ms.Range("I" & eor2)
            .Range("J" & x).Copy ms.Range("H" & eor2)
        End If
        
    Next x

End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "Code version took: " & Timer - dTimer & " seconds"
MsgBox "Found Duplicate Purchase order number. Please investigate before continuing!"

End Sub

Hi AB33 and Lexusap,

Excellent!!. Thank you for the solution. I will take care of balance part. Thanks once again.

Best Regards,
Narasimharao