0

I have two tables in two different sheets: one table contains the source data that I input by hand (in the sheet "Roadmap Data"), the other table (in the sheet "Overview") would be another container to keep the data that could change in the Roadmap Data sheet. My aim is copy the rows of the table in the Roadmap Data sheet only if not already present in the table of the Overview sheet. Here below the code I wrote, I took inspiration from another post

Public Sub CopyRowsAcross()

Dim ione, itwo As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Roadmap Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Overview")

For ione = 3 To ws1.Range("B65536").End(xlUp).Row
    itwo = 3
    Do Until itwo = ws2.Range("B65536").End(xlUp).Row + 1
        If ws1.Cells(ione, 2) = ws2.Cells(itwo, 2) And ws1.Cells(ione, 3) = ws2.Cells(itwo, 3) And ws1.Cells(ione, 4) = ws2.Cells(itwo, 4) And ws1.Cells(ione, 5) = ws2.Cells(itwo, 5) And ws1.Cells(ione, 6) = ws2.Cells(itwo, 6) And ws1.Cells(ione, 7) = ws2.Cells(itwo, 7) And ws1.Cells(ione, 8) = ws2.Cells(itwo, 8) Then
            Exit Do
        Else
            ws1.Rows(ione).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
            Exit Do
        End If
    itwo = itwo + 1
    Loop
Next ione
End Sub

The source data is something like this: enter image description here

but the result of the macro is wrong: enter image description here

Probably there's something wrong in the way I wrote the do until loop, I think I need a for cycle that loops the rows of the Overview sheet with "Or" conditions, but I can't image how to do it. Any suggestions to simplify the condition I used to verify if the rows of two tables are the same is appreciated.

codeghi
  • 13
  • 7

2 Answers2

0

The problem in your code is, that the DO-LOOP did not check all rows in ws2. The first if in the DO-LOOP checks the first row in ws2 and this is "Act3" ... IF("Act3" = "Act4") ? No it isn't, so please insert the Act4.

Try this:

Public Sub CopyRowsAcross()

Dim ione as Integer, itwo As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Roadmap Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Overview")
Dim found As Boolean

For ione = 3 To ws1.Range("B65536").End(xlUp).Row
    itwo = 3
    found = False
    Do Until itwo = ws2.Range("B65536").End(xlUp).Row + 1
        If ws1.Cells(ione, 2) = ws2.Cells(itwo, 2) _
           And ws1.Cells(ione, 3) = ws2.Cells(itwo, 3) _
           And ws1.Cells(ione, 4) = ws2.Cells(itwo, 4) _
           And ws1.Cells(ione, 5) = ws2.Cells(itwo, 5) _
           And ws1.Cells(ione, 6) = ws2.Cells(itwo, 6) _
           And ws1.Cells(ione, 7) = ws2.Cells(itwo, 7) _
           And ws1.Cells(ione, 8) = ws2.Cells(itwo, 8) _
           Then found = True
         itwo = itwo + 1

     Loop
         If found = False Then ws1.Rows(ione).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)

    Next ione
End Sub
Chris
  • 933
  • 1
  • 6
  • 16
  • Thank you, it works, maybe I'll try to improve the efficiency because with great number of rows it's a bit slow. But my big issue now is copy the row not at the end but at row number 3, so the table in the Overview sheet can resize automatically. Do you have any suggestions to do this? – codeghi Jun 14 '20 at 14:49
  • @codeghi: (1) What is the difference between "Roadmap_Data" and "Overvie". Looks like in both tables are the same data?! If so, why do not copy all data? Why checking? (2) I think meaning of "... Overview sheet resize automatically..." is "resize the table (Listobject) in Overview. Instead of copy to the end of data you could add a new row to the Listobject. (3) To improve the efficiency see point (1) or you could insert a flag column to "Roadmap_Data", if the row is copied the flag = "copied". So you only have to copy all rows with flag = "".... – Chris Jun 14 '20 at 17:20
0

@Chris

  1. The Roadmap Data contains new rows added or the same rows modified by some values in the columns, for example date and values changes in columns 4, 6 or 6. When I changes the rows, I want to keep the old values and that's the reason why I created the Overview sheet, that contains the current values but also the previous ones by checking the contents in the cells between the two sheets.
  2. I've just updated the code as you can see below, it's seems it's fine:

    For ione = 3 To ws1.Range("B65536").End(xlUp).Row
    itwo = 3
    found = False
    Do Until itwo = ws2.Range("B65536").End(xlUp).Row + 1
        If ws1.Cells(ione, 2) = ws2.Cells(itwo, 2) _
        And ws1.Cells(ione, 3) = ws2.Cells(itwo, 3) _
        And ws1.Cells(ione, 4) = ws2.Cells(itwo, 4) _
        And ws1.Cells(ione, 5) = ws2.Cells(itwo, 5) _
        And ws1.Cells(ione, 6) = ws2.Cells(itwo, 6) _
        And ws1.Cells(ione, 7) = ws2.Cells(itwo, 7) _
        And ws1.Cells(ione, 8) = ws2.Cells(itwo, 8) _
        Then found = True
        itwo = itwo + 1
    Loop
        If found = False Then
            ws2.Range("B3:H3").ListObject.ListRows.Add (1)
            ws1.Rows(ione).Copy ws2.Rows(3)
        End If
    Next ione
    
codeghi
  • 13
  • 7