Removing duplicates based on date criteria from two different sheets

Xie99

New Member
Joined
Apr 14, 2018
Messages
2
I have two sheets that I need to remove duplicates from "TestData" has two columns(A and C) of account numbers, and "Master" has two columns(A and B) account numbers and date. I need to compare the "Master" and "TestData" column C for duplicates and removed based on the following.

Compare "Master" account numbers and "TestData" Column C, if duplicates and > 41 days old from =Today() remove duplicates from "Master", else if duplicates and <= 41 days old from =Today() remove duplicates from "TestData" Column C.

My original issue was removing duplicates from "Master" and "TestData" Column A, if duplicates remove from "TestData" Column A, which I'm currently using the following code. Which I snagged from a video and changed to fit my needs to remove duplicates from two sheets:

Code:
Sub RemoveDupsBetweenLists()


Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim C1row As Long
Dim C2row As Long
Dim C2TotalRows As Long
Dim AccountNum As String
Dim NoDups As Long


Set sht1 = Worksheets("Master")
Set sht2 = Worksheets("TestData")
sht1.Activate
C2TotalRows = Application.CountA(Range("A:A"))
C1row = 2


Do While sht2.Cells(C1row, 1).Value <> ""


AccountNum = sht2.Cells(C1row, 1).Value


    For C2row = 2 To C2TotalRows
    
        If AccountNum = Cells(C2row, 1).Value Then
        
            sht2.Activate
            Rows(C1row).Delete
            NoDups = NoDups + 1
            C1row = C1row - 1
            sht1.Activate
            Exit For
            
        End If
    
    Next
    
    C1row = C1row + 1


Loop


MsgBox NoDups & " Duplicates were removed"


End Sub

How can I modify this or do I need something else?

Thanks in advance
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Xie99

New Member
Joined
Apr 14, 2018
Messages
2
Ok so I did some work on this and came up with

Code:
Sub RemoveDupsBasedOnDate()


Dim sht1 As Worksheet
Dim sht3 As Worksheet
Dim c1row As Long
Dim c2row As Long
Dim c3row As Long
Dim c1totalrows As Long
Dim accountnum As String
Dim MyDate As Date
MyDate = Today
Dim NoDups1 As Long
Dim NoDups2 As Long


Set sht1 = Worksheets("Master")
Set sht3 = Worksheets("TestData2")
sht1.Activate
c1totalrows = Application.CountA(Range("A:A"))
c2row = 2


Do While sht3.Cells(c2row, 1).Value <> ""


accountnum = sht3.Cells(c2row, 1).Value
    
    For c1row = 2 To c1totalrows
        
        If accountnum = Cells(c1row, 1).Value And sht1.Cells(c1row, 2) <= MyDate - 42 Then
        
            sht1.Activate
            Rows(c1row).Delete
            NoDups1 = NoDups1 + 1
            c1row = c1row - 1
            sht1.Activate
        
        ElseIf accountnum = Cells(c1row, 1).Value And sht1.Cells(c1row, 2) > MyDate - 42 Then
            
            sht3.Activate
            Rows(c2row).Delete
            NoDups2 = NoDups2 + 1
            c2row = c2row - 1
            sht1.Activate
        
        End If
        
    Next
    
    c1row = c1row + 1
    c2row = c2row + 1
        
Loop


MsgBox NoDups1 & " Duplicates > 41 days old removed from Master, and " & NoDups2 & " Duplicates <= 41 removed from TestData2."


End Sub

However it only runs the Elseif statement
 

Watch MrExcel Video

Forum statistics

Threads
1,114,472
Messages
5,548,241
Members
410,824
Latest member
Bobmn4
Top