VBA: Looping to check for non-matches then appending to a list when record not matched

[blonde]

Hello,

I have two sheets in which I am trying to append records from one to the other. The main list is ws2 and the second list, ws5, is the one to be populated with records from ws2 by appending record i to the last row in the list. Records are only to be appended where they do not exist in ws5. I am comparing on two different fields in both sheets to identify unique records. My issue is how to check if the record does not exist in ws5. Initially, ws5 will contain no records except for the column header, but will build up over time.

Here is my code so far. As I understand it, the For Each Cell statement will check through all existing records in ws5 comparing on the two different fields. I have learnt about loops used for checking through for matching records, however, I don't know how a loop could work to look for non-matching records. Somehow, the code needs to check through records in ws5 against those in ws2 and where the record does not exist in ws5, to append it.

Any help on this would be much appreciated.

Public Sub bulk_update_finance_4()

Dim ws2 As Worksheet
Dim ws5 As Worksheet
Dim Cell As Range
Dim Finalrow3 As Long

Set ws2 = ThisWorkbook.Sheets("Interim")
Set ws5 = ThisWorkbook.Sheets("Erasmus Finance")

Finalrow2 = Sheets("Interim").Range("F" & Rows.Count).End(xlUp).Row
Finalrow3 = Sheets("Erasmus Finance").Range("F" & Rows.Count).End(xlUp).Row

On Error Resume Next

For i = 2 To Finalrow2
    For Each Cell In ws5.Range("F7:F" & Finalrow3)
        If Cell.Value <> ws2.Cells(i, 6).Value And _
            Cell.Offset(, 3).Value <> ws2.Cells(i, 7).Value Then
            ws2.Range("A:N" & i).Copy
            ws5.Range(Finalrow3 + 1).PasteSpecial xlPasteValues
        End If
    Next Cell
Next i

End Sub

 

[Fluff]

How about

Sub CompareAdd()

   Dim ws2 As Worksheet
   Dim ws5 As Worksheet
   Dim Cl As Range
   Dim ValU As String
   Dim Itm As Variant
   
   Set ws2 = ThisWorkbook.Sheets("Interim")
   Set ws5 = ThisWorkbook.Sheets("Erasmus Finance")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In ws2.Range("F2", ws2.Range("F" & Rows.count).End(xlUp))
         ValU = Cl.Value & "|" & Cl.Offset(, 1).Value
         If Not .exists(ValU) Then .Add ValU, Cl.Offset(, -5)
      Next Cl
      For Each Cl In ws5.Range("F2", ws5.Range("F" & Rows.count).End(xlUp))
         ValU = Cl.Value & "|" & Cl.Offset(, 3).Value
         If .exists(ValU) Then .Remove ValU
      Next Cl
      For Each Itm In .items
         ws5.Range("A" & Rows.count).End(xlUp).Offset(1).Resize(, 13).Value = Itm.Resize(, 13).Value
      Next Itm
   End With
         
End Sub

 

[blonde]

Hi,

This is brilliant, it is working and is fast too. I haven't come across the scripting dictionary object before. Thank you very much for your help.

I do have one problem on the code however where I need to adjust where the data goes in ws5. I have added a couple of extra lines with an
offset to populate a bit differently including two further columns in ws5. The first offset works fine (range "Q"), but the second offset
(range"R") is not populating the values against the correct records, instead it is simply populating from the first row down below the column headers in ws5. In ws2, there are blanks in these two columns from the first row until over a hundred rows down. I'm wondering if the blank cells have something to do with it?

Here is my revision:

For Each Itm In .items
         ws5.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 6).Value = Itm.Resize(, 6).Value
         ws5.Range("Q" & Rows.Count).End(xlUp).Offset(1).Resize(, 1).Value = Itm.Offset(, 7).Resize(, 1).Value
         ws5.Range("R" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Itm.Offset(, 14).Resize(, 2).Value
      Next Itm

 

[Fluff]

Ok, try

      For Each Itm In .items
         ws5.Range("A" & Rows.count).End(xlUp).Offset(1, 17).Resize(, 2).Value = Itm.Offset(, 14).Resize(, 2).Value
         ws5.Range("A" & Rows.count).End(xlUp).Offset(1, 16).Value = Itm.Offset(, 7).Value
         ws5.Range("A" & Rows.count).End(xlUp).Offset(1).Resize(, 6).Value = Itm.Resize(, 6).Value
      Next Itm

 

[blonde]

I've got this working now, it's marvellous! A very big thank you for your help. I've learnt a lot today from this.

 

[Fluff]

Glad to help & thanks for the feedback