Find Duplicates, 2 Columns, Different Worksheets

[ghendi]

Hey Admin,

Just gave it a shot and all is looking well.

Could you please add to the code the ability to add to Column K in the master sheet the value 0 when it is copied over?

Also, can you please confirm that both Column D and E are being checked in order to find the duplicate rows? I'm just worried 2 members with the same street address but different unit numbers will be considered duplicates.

Thank you!!

-Amit

[Admin]

Hi

try thid.

Option Explicit

Sub kTest()
    
    Dim ka, k(), i As Long, n As Long, c As Long, d As Object
    Dim DupeCount   As Long, addr As String, wksNewData As Worksheet
    Dim UniqueString    As String
    
    
    Const MasterSheet   As String = "Sheet1"    '<< adjust
    
    Set d = CreateObject("scripting.dictionary")
        d.comparemode = 1
    
    ka = ThisWorkbook.Worksheets(MasterSheet).Range("a1").CurrentRegion.Resize(, 10).Value2
    
    'loop thru master sheet
    For i = 2 To UBound(ka, 1)
        UniqueString = Trim(ka(i, 4)) & Trim(ka(i, 5))      '<<< adjust the columns
        If Len(UniqueString) Then
            d.Item(UniqueString) = Empty
        End If
    Next
        
    Erase ka
    Set wksNewData = ThisWorkbook.Worksheets(2)
    ka = wksNewData.Range("a1").CurrentRegion.Resize(, 10).Value2
    ReDim k(1 To UBound(ka, 1), 1 To UBound(ka, 2))
    
    For i = 2 To UBound(ka, 1)
        UniqueString = Trim(ka(i, 4)) & Trim(ka(i, 5))      '<<< adjust the columns
        If Not d.exists(UniqueString) Then
            n = n + 1
            For c = 1 To UBound(ka, 2)
                k(n, c) = ka(i, c)
            Next
        Else
            DupeCount = DupeCount + 1
            addr = addr & ",D" & i
            If Len(addr) > 245 Then
                wksNewData.Range(Mid(addr, 2)).Interior.Color = 65535
                addr = vbNullString
            End If
        End If
    Next
    If Len(addr) > 1 Then
        wksNewData.Range(Mid(addr, 2)).Interior.Color = 65535
        addr = vbNullString
    End If
    If n Then
        'append new record into the master sheet
        With ThisWorkbook.Worksheets(MasterSheet)
            .Range("a" & .Rows.Count).End(xlUp).Offset(1).Resize(n, UBound(k, 2)) = k
        End With
    End If
    If DupeCount Then
        MsgBox "There are " & DupeCount & " duplicates.", vbInformation
    End If
    
End Sub

[ghendi]

UniqueString = Trim(ka(i, 4)) & Trim(ka(i, 5))      '<<< adjust the columns

I'm not sure what you mean by "adjust columns". What do I need to do?

[Admin]

currently it's col D and col E. If it's not the actual columns replace 4 and 5 with appropriate col number.

[ghendi]

Admin,

Thank you for your patience! The code is running perfectly. I appreciate all your help.