PDA

View Full Version : Copy data from another worksheet if it doesn't exist in current worksheet



abhay_547
04-17-2019, 07:56 PM
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

p45cal
04-18-2019, 03:39 PM
Sub blah()
With Sheets("Account Definition Mapping")
ADMColumn = Application.Match(Sheets("Data").Range("J1").Value, .Rows(1), 0)
Set DestnTable = .Cells(1, ADMColumn).CurrentRegion
End With
Set DestnTable = Intersect(DestnTable, DestnTable.Offset(1))
Set SceTable = Sheets("Data").Range("A1").CurrentRegion
Set SceTable = Intersect(SceTable, SceTable.Offset(1))
Union(SceTable.Columns(1), SceTable.Columns(3)).Copy DestnTable.Cells(DestnTable.Rows.Count, 1).Offset(1)
DestnTable.Cells(DestnTable.Rows.Count, 1).Offset(1).Resize(SceTable.Rows.Count, 2).Interior.Color = vbYellow
DestnTable.Resize(DestnTable.Rows.Count + SceTable.Rows.Count).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End Sub
If I've got the wrong sheet with yellow highlights then:

Sub blah()
With Sheets("Account Definition Mapping")
ADMColumn = Application.Match(Sheets("Data").Range("J1").Value, .Rows(1), 0)
Set DestnTable = .Cells(1, ADMColumn).CurrentRegion
End With
Set DestnTable = Intersect(DestnTable, DestnTable.Offset(1))
Set SceTable = Sheets("Data").Range("A1").CurrentRegion
Set SceTable = Intersect(SceTable, SceTable.Offset(1))
Union(SceTable.Columns(1), SceTable.Columns(3)).Copy DestnTable.Cells(DestnTable.Rows.Count, 1).Offset(1)
Set DBRng = DestnTable.Cells(DestnTable.Rows.Count, 1).Offset(1).Resize(SceTable.Rows.Count, 2)
DestnTable.Resize(DestnTable.Rows.Count + SceTable.Rows.Count).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
Set NewRowRng = Intersect(DBRng, DBRng.CurrentRegion)
For Each rw In NewRowRng.Rows
ECD = rw.Cells(1).Value
Add = rw.Cells(2).Value
For Each rowe In SceTable.Rows
If rowe.Cells(1).Value = ECD And rowe.Cells(3).Value = Add Then rowe.Interior.Color = vbYellow
Next rowe
Next rw
End Sub

abhay_547
04-21-2019, 09:59 AM
hi p45cal,

The above code is adding the data to Account Definition Mapping sheet as well, where else we just want the macro to check the data in the account mapping sheet based on the account definition model selected by user in data sheet and add the data for missing entity, account definition and account number combination in data worksheet highlighting it in the yellow. Nothing needs to be added in the account definition mapping worksheet, it should be only reference purpose.

p45cal
04-22-2019, 08:29 AM
Clearly I can't read. Hopefully I have it right now.

Sub blah2()
With Sheets("Account Definition Mapping")
ADMColumn = Application.Match(Sheets("Data").Range("J1").Value, .Rows(1), 0)
Set ADMTable = .Cells(1, ADMColumn).CurrentRegion
End With
Set ADMTable = Intersect(ADMTable, ADMTable.Offset(2))
ADMVals = ADMTable.Value
Set SceTable = Sheets("Data").Range("A1").CurrentRegion
Set SceTable = Intersect(SceTable, SceTable.Offset(1))
SceVals = SceTable.Value
Set myDestn = SceTable.Cells(1).Offset(SceTable.Rows.Count).Resize(, 3)
Set dict = CreateObject("scripting.dictionary")

For i = 1 To UBound(SceVals)
If Not dict.exists(SceVals(i, 2)) Then
dict.Add SceVals(i, 2), SceVals(i, 2)
For k = 1 To UBound(ADMVals)
Found = False
For j = i To UBound(SceVals)
If SceVals(i, 2) = SceVals(j, 2) Then
If ADMVals(k, 1) = SceVals(j, 1) Then
If ADMVals(k, 2) = SceVals(j, 3) Then
Found = True
Exit For
End If
End If
End If
Next j
If Not Found Then
With myDestn
.NumberFormat = "@"
.Value = Array(ADMVals(k, 1), SceVals(i, 2), ADMVals(k, 2))
.Interior.Color = 65535
Set myDestn = .Offset(1)
End With
End If
Next k
End If
Next i
End Sub
I have NOT thoroughly tested this.
Just be aware, that your sample data might be anomalous in 2 instances
1. If Model 1 is used, you end up with Acc No. 0786187364 having 2 Entity codes 0714, one for Legal Fees, one for Business Consulting (both originally present).
2. If model 2 is used, you end up with Acc No. 0786187436 having 2 Entity codes 0841, one Funding and Finance, one Legal Fees, again both originally present but after running the macro you end up with that Acc No. with a second Legal Fees Acc. Definition (Entity 0714) being added.

abhay_547
04-22-2019, 07:19 PM
sorry if my comments where not clear earlier. I want the macro check if a account number entry already exists in the data sheet with the entity and account definition combination listed in the account definition model selected by user (in J1 cell) and if it doesn't exist only then include the same in the data worksheet and highlight that added entry in yellow.

abhay_547
04-22-2019, 07:20 PM
Hi p45cal,

sorry if my comments where not clear earlier. I want the macro check if a account number entry already exists in the data sheet with the entity and account definition combination listed in the account definition model selected by user (in J1 cell) and if it doesn't exist only then include the same in the data worksheet and highlight that added entry in yellow.

p45cal
04-23-2019, 12:54 AM
Doesn't blah2 do that?