Consulting

Results 1 to 7 of 7

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

  1. #1

    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.

    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
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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
    Last edited by p45cal; 04-18-2019 at 05:06 PM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    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.

  4. #4
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5
    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.

  6. #6
    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.

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Doesn't blah2 do that?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •