Copy data from another worksheet if it doesn't exist in current worksheet

[abhay_547]

I have 2 worksheets in my workbook, one is named as "Data" and another one is named as "Account Definition Mapping", the Data worksheet consists of 3 columns .i.e. Entity Code (Column A), Account Number (Column B) and Account Definition (Column C) and Account Definition Mapping consists of Entity code and Account Definition column in 2 sets (.i.e. Column A & B [Account definition model 1] and D & E [Account Definition Model 2]), first set is called Account Definition Model 1 and Second set is called Account Definition Model 2.


Now I want my macro to check the Data Worksheet Column A, B and C in combination and if for a particular account the entity code and account definition doesn't exist then copy the same from Account Definition mapping worksheet and insert those rows for that account in Data worksheet. The issue over here is we don't have the account number column in the account Definition mapping worksheet so we can't simply compare both directly one to one, Also Account definition mapping model can be chosen by user by selecting the same from Data sheet Cell J2, based on which macro should either check from column A and B if user selects Account Definition Model 1 but If he selects Account Definition Model 2 then macro should check the existence of data in column D and E of Account Definition Mapping worksheet.


Below is the code which I have got which ideally check based on all fields comparing one to one between both worksheets but as mentioned earlier the problem is that we don't have the account number field in the Account Definition Worksheet so it's comparing the 3 columns data .i.e. Entity Code, Account Number and Account Definition combination from the data worksheet against 2 columns .i.e. Entity Code and Account Defintion in Account Definition mapping to see the entity code and account definition combination listed in Account Definition mapping field exists in the Data worksheet for all the accounts in Data worksheet and if not then add the same and highlight in yellow. Attached is the workbook.

Option Explicit

    Sub CopymissingData()

    Dim k, kk(), i As Long, c As Long
    Dim n As Long, q, s As String

    q = Array(4, 5, 8, 9)
    k = Sheets("Data").Range("a1").CurrentRegion.Value2
    ReDim kk(1 To UBound(k, 1), 1 To UBound(k, 2))

    With CreateObject("scripting.dictionary")
    .comparemode = 1
    For i = 2 To UBound(k, 1)
    s = vbNullString
    For c = 0 To UBound(q): s = s & "|" & k(i, q(c)): Next
    .Item(s) = Empty
    Next
    k = Sheets("Account Definition Mapping").Range("a1").CurrentRegion.Value2
    For i = 2 To UBound(k, 1)
    s = vbNullString
    For c = 0 To UBound(q): s = s & "|" & k(i, q(c)): Next
    If Not .exists(s) Then
    n = n + 1
    For c = 1 To UBound(k, 2): kk(n, c) = k(i, c): Next
    End If
    Next
    End With

    If n Then
        With Sheet1

            With .Range("a" & .Rows.Count).End(xlUp)(2).Resize(n, UBound(kk, 2))
                .Value = kk
                .Interior.Color = vbYellow
            End With
        End With
    End If

    End Sub