Merging records from one spreadsheet into another

Question

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 ---> Do nothing
'      if not found in Steps ----> 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


'---> Disable Events
With Application
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

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

'---> 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" & MaxRowO).Find(what:=sJob, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not cCell Is Nothing Then
        bNotFound = True
        sFirstAddress = cCell.Address
        Do
            '---> 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" & MaxRowO).FindNext(cCell)
        Loop While Not cCell Is Nothing And cCell.Address <> sFirstAddress
    Else
        bNotFound = True
    End If

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


Next I

'---> Enable Events
With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

UpdateNEW = lAdd

End Function

Answer 1

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) & Delimiter & 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) & Delimiter & 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 > 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)