1 Attachment(s)
Copy data from another worksheet if it doesn't exist in current worksheet
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.
Code:
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
