Copy Only New/Different Items to a List

[mharper90]

I use this macro to take an active roster of people and some data about them, and transfer portions of it to a secondary roster. Unique to the secondary roster is that no one should ever be deleted from the secondary roster. The primary roster is active in the sense that people are constantly being added and deleted.

The macro below copies and pastes all people who meet the criteria of having the word "NO" in column A, which proceeds their Name in column B, and some number data about them in other columns. Currently the macro clears the secondary roster prior to the copy and paste action. I will need to remove this feature, as this will delete someone off of the secondary roster if they no longer exist on the primary roster.

The problem is, in this action of copy and paste, I want the macro to only copy names that don't already exist on the secondary roster (so just the new additions to the primary roster). I don't want a name to populate twice on the secondary roster.

btw, the primary roster is always ws1. ws2 is the secondary roster, but changes based on what quarter of the year it is. The primary roster shows the movement of people, but once someone existed during a quarter, they are never to be deleted from the secondary roster for that quarter. Once the next quarter is activated, all names currently on the primary roster are "new" to the new quarter's secondary roster.

Also, any help in cleaning up my code is much appreciated!

Sub cpypste5()


    Dim x    As String
    Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Main Data")
    Dim ws2 As Worksheet
    Dim r1     As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, multiAreaRange As Range
    Dim c     As Range
    Dim Lr     As Long


        Set r1 = ws1.Range("B B")
        Set r2 = ws1.Range("C:C")
        Set r3 = ws1.Range("E E")
        Set r4 = ws1.Range("F F")
        Set r5 = ws1.Range("H:H")


    If ws1.Range("$C$4") = "1" Then                 '//Uses Period # from Main Data sheet
        Set ws2 = ThisWorkbook.Sheets("P1 Figure 2—2")         'to direct data to the correct period's
        ElseIf ws1.Range("$C$4") = "2" Then             'Figure 2—2
        Set ws2 = ThisWorkbook.Sheets("P2 Figure 2—2")         '
        ElseIf ws1.Range("$C$4") = "3" Then             'Max of 8 Periods
        Set ws2 = ThisWorkbook.Sheets("P3 Figure 2—2")        '
        ElseIf ws1.Range("$C$4") = "4" Then            '
        Set ws2 = ThisWorkbook.Sheets("P4 Figure 2—2")        '
        Else: Exit Sub                        '
    End If                                //


    Set multiAreaRange = Union(r1, r2, r3, r4, r5)
    
Application.ScreenUpdating = False


    x = "NO"


    ws2.Rows("3:" & Rows.Count).Delete                     'Clears Figure 2-2 selected above


    If Not IsError(Application.Match(x, ws1.Range("A:A"), 0)) Then             '//Copy and paste Name, TLD#, & Dates
                                            'from Main Data page to Figure 2—2
        ws1.Range("E:F").EntireColumn.Hidden = False                'above for all members with
                                            ' "NO" ERC.
        ws1. Range("A3"). CurrentRegion. AutoFilter Field:=1, Criteria1:=x    '
        Intersect(ws1.AutoFilter.Range.Offset(1), multiAreaRange).Copy _
            Destination: =ws2.Range("A" & Rows.Count).End(xlUp).Offset(1)    '
        ws1.AutoFilterMode = False                        '
                                            '
        ws1.Range("E:F").EntireColumn.Hidden = True                '
                                            '
    End If                                        '//


SortGroup2Printout                                'Alphabetizes Figure 2-2


    ws2.Range("A:F").Interior.ColorIndex = xlNone                'Removes any background color copied over


    Lr = ws2.Range("A" & Rows.Count).End(xlUp).Row


    If Lr > 2 Then
        ws2.Range("F3:F" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,8,FALSE)"
        ws2.Range("G3:G" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,9,FALSE)"
        ws2.Range("H3:H" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,10,FALSE)"
        ws2.Range("I3:I" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,11,FALSE)"
        ws2.Range("J3:J" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,12,FALSE)"
        ws2.Range("K3:K" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,13,FALSE)"
        ws2.Range("L3:L" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,14,FALSE)"
        ws2.Range("M3:M" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,15,FALSE)"
        If ws1.Range("$C$4") = "1" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-F3"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,8,FALSE)"
        ElseIf ws1.Range("$C$4") = "2" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:G3)"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,9,FALSE)"
        ElseIf ws1.Range("$C$4") = "3" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:H3)"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,10,FALSE)"    
        ElseIf ws1.Range("$C$4") = "4" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:I3)"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,11,FALSE)"
        ElseIf ws1.Range("$C$4") = "5" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:J3)"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,12,FALSE)"
        ElseIf ws1.Range("$C$4") = "6" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:K3)"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,13,FALSE)"
        ElseIf ws1.Range("$C$4") = "7" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:L3)"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,14,FALSE)"
        ElseIf ws1.Range("$C$4") = "8" Then
            ws2.Range("N3:N" & Lr).Formula = "=E3-SUM(F3:M3)"
            ws2.Range("O3:O" & Lr).Formula = "=VLOOKUP(A3,'Main Data'!B:N,15,FALSE)"
        End If
    Else
    End If


Run ("clearzeros")                            'Removes zeros from column O based on verification




    For Each c In ws2.Range("C3:D" & Lr)                    '//Removes issue/collection dates
        If c > Date Then                        'if they are in the future.
            c = ""                            '
        Else                                '
        End If                                '
    Next                                    '//




    With ws2
        With Application.ErrorCheckingOptions
            .BackgroundChecking = False
            .EvaluateToError = False
            .InconsistentFormula = False
        End With
    End With




    ws2.Range("A1:O" & Lr).Borders.LineStyle = xlContinuous            
    ws2.Range("A1:0" & Lr).BorderAround _
        ColorIndex:=1, Weight:=xlMedium


    With ws2.Range("A" & Rows.Count).End(xlUp).Offset(5, 1)            '//Places CRA Review Box 4 rows
        .Value = "Closeout Review: _______________ Date: _________"    'under last data row.
        With ws2.Range("A” & Rows.Count).End(xlUp).Offset(6, 1)        '
            .Value = "               CRA"                '
        End With                            '
        .Resize(3, 13).Offset(-1, 0).BorderAround _
            ColorIndex:=1, Weight:=xlMedium                '
    End With                                '//


Application.ScreenUpdating = True
End Sub

 

[Fluff]

Duplicate https://www.mrexcel.com/forum/excel-questions/1077363-dealing-duplicates.html#post5175959

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).

If you do not receive a response, you can "bump" it by replying to it again, though we advise you to wait 24 hours before doing and not to bump a thread more than once a day.