Comparing Lists for new values - Dictionary or Array?

[Davavo]

Hi folks.
I have some working code here but it is very slow. Could anyone suggest a faster alternative?
I did try using the dictionary but eventually gave up. It was the passing of the dictionary to and from the sub while also passing the sheet name that was causing the problems.
I think perhaps using an array would be faster and easier. But i am not sure.

The workbook is to record emails.
A new sheet will be added by the user, that will have a list of email addresses.
The code looks through that sheet and compares each value to an existing archive of email addresses. If no match is found, the email is added to the bottom of the archive list.
Any help would be greatly appreciated. Thanks.

'Reads through a list of values in Column A of a worksheet (worksheet name is variable 'NamecatchString' passed from main sub)
'and compares each value to an archive list, adding any new values to the archive

Sub CompareAndWrite(NamecatchString As String)
    Dim Aws As Worksheet                                'The Archive Sheet
    Dim Tws As Worksheet                                'The Target Sheet containing the new list to be checked
    Set Aws = sht_Archive
    Set Tws = ThisWorkbook.Worksheets(NamecatchString)  'There may be several new sheets with lists
   
    Dim ALastRow As Long                                'The last row of the archive
    Dim TLastRow As Long                                'The last row of the Target Sheet
    ALastRow = Aws.Cells(Rows.Count, 1).End(xlUp).row
    TLastRow = Tws.Cells(Rows.Count, 1).End(xlUp).row
   
    Dim Trg As Range
    Set Trg = Tws.Range("A2:A" & TLastRow)              'Declare the Range to be searched

    Dim Arg As Range                                    'Declare the Archive Range
    Dim FoundRg As Range                                'A variable that is defined by finding a match (not sure why it has to be a range rather than a string)
    Dim Cell As Range
   
    For Each Cell In Trg
   
        Set Arg = Aws.Range("A2:A" & ALastRow)
        Set FoundRg = Arg.Find(Cell.Value)
       
        If FoundRg Is Nothing Then                      'If no match is found, add the value in the search to the archive
           
            ALastRow = ALastRow + 1                     'Add one row to last row of the archive
            Aws.Cells(ALastRow, 1).Value = Cell.Value   'Add the search value to the archive
               
                                                                              'Debug.Print "Added " & Cell.Value & " to the archive"
        End If
    Next Cell
   
End Sub

 

[Davavo]

Yes, that works, and is a good bit faster!
Thank you! Very much appreciated!