Merging records from one spreadsheet into another I have created the code below that compare two spreadsheets . It initially compares the range of value from sheet1 ("Status") to sheet2 ("Interface") . Whenever a range matches with the ranges present in other sheet , it does nothing .When the range does not any matches in the other sheet , then the entire record is copied from sheet2 to sheet1 . I have around 1500 rows of data in both sheets with 15 columns . It takes around 30 minutes . 
. I look forward to see If I could get any help.

 Option Explicit

Function UpdateNEW() As Long
'   This Sub will do the Following Update
'   Run through all records in NEW
'      if found in Steps ---&gt; Do nothing
'      if not found in Steps ----&gt; Add it to Steps
'

Dim WSO As Worksheet
Dim WSN As Worksheet
Dim MaxRowO As Long, MaxRowN As Long, I As Long, J As Long, lAdd As Long
Dim sJob As String, sOps As String, sFirstAddress As String
Dim cCell As Range
Dim bNotFound As Boolean


'---&gt; Disable Events
With Application
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

'---&gt; Set Variables
Set WSO = Sheets("Steps")
Set WSN = Sheets("Interface")
MaxRowO = WSO.Range("A" &amp; WSO.Rows.Count).End(xlUp).Row
MaxRowN = WSN.Range("C" &amp; WSN.Rows.Count).End(xlUp).Row
WSN.Range("P6:P" &amp; MaxRowN).ClearContents

'---&gt; Loop thruough all rows in sheet New
For I = 6 To MaxRowN
    bNotFound = False
    sJob = WSN.Cells(I, "D")
    sOps = WSN.Cells(I, "E")
    Set cCell = WSO.Range("B2:B" &amp; MaxRowO).Find(what:=sJob, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not cCell Is Nothing Then
        bNotFound = True
        sFirstAddress = cCell.Address
        Do
            '---&gt; Check to See if Ops if found for that Job
            If WSO.Cells(cCell.Row, "C") = sOps Then
                bNotFound = False
                Exit Do
            End If
            Set cCell = WSO.Range("B2:C" &amp; MaxRowO).FindNext(cCell)
        Loop While Not cCell Is Nothing And cCell.Address &lt;&gt; sFirstAddress
    Else
        bNotFound = True
    End If

    '---&gt; Add Record to OLD if Not Found
    If bNotFound Then
        WSN.Range("C" &amp; I &amp; ":O" &amp; I).Copy WSO.Range("A" &amp; MaxRowO + 1)
        'WSN.Range("P" &amp; I) = "Copied to OLD"
        'WSO.Range("N" &amp; MaxRowO + 1) = sJob &amp; " " &amp; sOps &amp; " Copied from New row " &amp; I
        MaxRowO = MaxRowO + 1
        lAdd = lAdd + 1
    End If


Next I

'---&gt; Enable Events
With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

UpdateNEW = lAdd

End Function
The unique data could be appended, using a Scripting Dictionary and arrays in less than a second.  Alternatively, you could use an ADO Query to append records from sheet1, not in sheet2.

The easiest method would be to add all the records to the second worksheet then record a macro that:


Convert the range to a table
Select a cell in the range then click Ribbon >  Table Tools > Remove Duplicates


All that is left to do is refactor the Macro to make the code dynamic.

Watch:
 - Excel VBA Introduction Part 25 - Arrays
 - Excel VBA Introduction Part 39 - Dictionaries
 - Excel VBA Introduction Part 32 - ADO (ActiveX Data Objects) SQL Statements (INSERT, UPDATE, DELETE)



Here is how I would rewrite the OP's code using a Scripting Dictionary and arrays.

Function UpdateNEW2() As Long
    Const Delimiter As String = "|"
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Dim newRows As Range
    Dim vSteps, key
    With Sheets("Steps")
        vSteps = .Range("A2:O2", .Cells(.Rows.Count, 2).End(xlUp)).Value
    End With

    Dim r As Long, c As Long, n As Long
    For r = 1 To UBound(vSteps)
        key = vSteps(r, 3) &amp; Delimiter &amp; vSteps(r, 4)
        Debug.Print key
        If Not dic.Exists(key) Then dic.Add key, 0
    Next

    Dim vInterface, results
    With Sheets("Interface")
        vInterface = .Range("A7:O7", .Cells(.Rows.Count, "C").End(xlUp)).Value
    End With

    ReDim results(1 To UBound(vInterface), 1 To 15)
    For r = 1 To UBound(vInterface)
        key = vInterface(r, 4) &amp; Delimiter &amp; vInterface(r, 5)
        Debug.Print key
        If Not dic.Exists(key) Then
            n = n + 1
            For c = 3 To 15
                results(n, c - 2) = vInterface(r, c)
            Next
        End If
    Next
    If n &gt; 0 Then
        With Sheets("Steps")
            With .Cells(.Rows.Count, 2).End(xlUp).Offset(1)
               .Resize(n, 15).Value = results
            End With
        End With
    End If
    UpdateNEW2 = n
End Function


(Sample Data)