Code is amazing, but I cant make a small adjustment

[Rokas19990319]

@Fluff
Dear Fluff,
You helped someone almost a year ago and provided this code, I was hoping you could slightly adjust this code to take the different values rather than matching ones and paste them into workbook A rather than into a new one. It would be a lifesaver as this code works surprisingly fast and my old code does this same thing for many hours with many rows and is way longer
It would also be great if in the new workbook it would be pasted below the last used row

Sub MY_SUB()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim WbkA As Workbook, WbkB As Workbook, WbkC As Workbook
Dim Ary As Variant, Nary As Variant
Dim Dic As Object
Dim r As Long, c As Long, nr As Long

Set WbkA = Workbooks("Workbook.xlsx")
'Set WbkB = Workbooks("Workbook.xlsx")
Set WbkC = Workbooks("ExtractFile.xlsx")

Set Dic = CreateObject("scripting.dictionary")
Dic.comparemode = 1

With WbkC.Sheets(1)
    Ary = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value2
End With

For r = 1 To UBound(Ary)
    Dic(Ary(r, 1)) = Empty
Next r

With WbkA.Sheets(1)
    c = .Cells(1, Columns.Count).End(xlToLeft).Column
    Ary = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, c).Value2
End With

ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
For r = 1 To UBound(Ary)
    If Dic.Exists(Ary(r, 5)) Then
        nr = nr + 1
        For c = 1 To UBound(Ary, 2)
        Nary(nr, c) = Ary(r, c)
        Next c
    End If
Next r

WbkA.Sheets(1).Range("A35000").Resize(nr, UBound(Nary, 2)).Value = Nary

'WbkA.Close True
'WbkB.Close True
'WbkC.Close True

MsgBox "GENERATED!"

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[Peter_SSs]

@Rokas19990319
I have edited your thread title. Refer to #4 of the Forum Rules to see why. I have added the tag within your post which is allowed under that rule (provided such tagging is not over-used)

 

[Rokas19990319]

@Rokas19990319
I have edited your thread title. Refer to #4 of the Forum Rules to see why. I have added the tag within your post which is allowed under that rule (provided such tagging is not over-used)

Noted

 

[Rokas19990319]

Also, To show my previous attempt, this worked, but was really slow, as far AS I understand arrays speed this up, as they store the information rather than working directly with windows clipboard, but I do not exactly understand how to include them into my original code, it works, but very slowly. Perhaps the old code will provide more info of what was attempted.
This specific code used manual row count and found all different A column values and made them vbBlue. Then all vbBlue ROWS were transfered to the destination workbook.

Sub moduleUpdate()


    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim recRow As Long
    Dim lastRow As Long
    Dim fCell As Range
    Dim i As Long
    Dim rCell As Range
    Dim LastRows As String
    Dim cell As Range
    Dim rng As Range
    Dim FoundRange As Range
  
 
  
    
    LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    Set DstFile = Workbooks("ExtractFile.xlsx")
    Set wsSource = Workbooks("ExtractFile.xlsx").Worksheets("Sheet1")
    Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")
    
    Application.ScreenUpdating = False
    
    recRow = 1
    
    With wsSource
       lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For i = 2 To lastRow
            'See if item is in Master sheet
            Set fCell = wsDest.Range("A:A").Find(what:=.Cells(i, "A").Value, LookAt:=xlWhole, MatchCase:=False)
            
            If Not fCell Is Nothing Then
                'Record is already in master sheet
                recRow = fCell.Row
            Else
                'Need to move this to master sheet after last found record
                .Cells(i, "A").Interior.Color = vbBlue
                recRow = recRow + 1
                
            End If
        Next i
    End With



    Set rng = Range("A1:A90000")
    'LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    For Each cell In rng.Cells
    If cell.Interior.Color = vbBlue Then
    If FoundRange Is Nothing Then
    Set FoundRange = cell
    Else
    Set FoundRange = Union(FoundRange, cell).EntireRow
    End If
    End If
    Next cell
    If Not FoundRange Is Nothing Then FoundRange.Select
    Selection.Copy
    Workbooks("Workbook.xlsx").Activate
    ActiveWorkbook.Sheets("Sheet1").Activate
    ' LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    Range("A:Y").Select
    Workbooks("Workbook.xlsx").Worksheets("Sheet1").PasteSpecial
    'If Not FoundRange Is Nothing Then FoundRange.Select



    
        
    'Clean up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    'DstFile.Save
   'DstFile.Close



End Sub

 

[Rokas19990319]

@Fluff any advice where to try to change the code to take the different values rather than matching? Been trying to figure that out but feel stuck,
would be amazing help as ive been stuck with this task for ages now

 

[Rokas19990319]

I can also update that values are only numbers and letters, no formulas, identical to TropicalMagic thread, I am facing 75000+rows in both files, If anything is unclear about what is attempted by the code please kindly ask, thanks :P