Excel VBA copy cells (after comparison)

Question

This is my first post so please bear with me

I just despair ... maybe someone can help with the following VBA code?

I have two "almost" identical tables. In one of them, comments are stored in column Q. I want to transfer the comments from the "old" table to the "new" table after comparing columns B and G.

Unfortunately the code runs only up to line 60 ... then it stops. The code should of course run to the end of the table, even if in between a new content has been added to a row.

Sub Copy()
Dim rng As Range


For Each rng In Sheets("04_2023").Range(Cells(2, 2), Cells(Rows.Count, 1).End(xlUp))
If Sheets("Kreuztabelle").Cells(rng.Row, 2) = Sheets("04_2023").Cells(rng.Row, 2) And _
Sheets("Kreuztabelle").Cells(rng.Row, 7) = Sheets("04_2023").Cells(rng.Row, 7) Then
Sheets("Kreuztabelle").Cells(rng.Row, 17).Copy _
Destination:=Sheets("04_2023").Cells(rng.Row, 17)
Sheets("Kreuztabelle").Cells(rng.Row, 18).Copy _
Destination:=Sheets("04_2023").Cells(rng.Row, 18)
End If
Next rng

End Sub

Thank you in advance for your help and support

Shouldn't the `1` in `Cells(Rows.Count, 1).End(xlUp)` be a `2`? — BigBen, Apr 28 '23 at 20:16
Thx for your quick reply Even with 2 the code does not work consistently — Blackjack, Apr 28 '23 at 20:19
Also see [this](https://stackoverflow.com/questions/8047943/excel-vba-getting-range-from-an-inactive-sheet). — BigBen, Apr 28 '23 at 20:22
I have now also tried with "ActiveSheet", unfortunately without success. But thanks for the hint. — Blackjack, Apr 28 '23 at 20:33
Are the two tables ordered identically? You're only looping over the destination table but not the source table. — Tim Williams, Apr 28 '23 at 22:34
You wrote : _Even with 2 the code does not work consistently_ ... may I know what did you mean by that ? (A) sometimes it work as expected but sometimes it doesn't ? (B) sometimes it runs only up to line 60 - sometimes run only up to another line (not line 60). Please CMIIW. Anyway, if it's consistent that in runs only up to line 60, I will add rng.select inside the loop and while sheet 04_2023 active, I will step run the code and see why it doesn't continue to the next row when the rng.row reach 60. — karma, Apr 29 '23 at 02:45

score 0 · Answer 1 · answered Apr 29 '23 at 03:54

0

try

Sub CompareAndCopy()
    Dim krSheet As Worksheet
    Dim destSheet As Worksheet
    Dim krLastRow As Long
    Dim krCell As Range
    
    Set krSheet = ThisWorkbook.Worksheets("Kreuztabelle")
    Set destSheet = ThisWorkbook.Worksheets("04_2023")
    
    krLastRow = krSheet.Cells(krSheet.Rows.Count, "B").End(xlUp).Row
    
    For Each krCell In krSheet.Range("B2:B" & krLastRow)
        If krCell = destSheet.Cells(krCell.Row, "B") And krSheet.Cells(krCell.Row, "G") = destSheet.Cells(krCell.Row, "G") Then
            krSheet.Cells(krCell.Row, 17).Copy destSheet.Cells(krCell.Row, 17)
            krSheet.Cells(krCell.Row, 18).Copy destSheet.Cells(krCell.Row, 18)
        End If
    Next krCell
End Sub

answered Apr 29 '23 at 03:54

k1dr0ck

1,043
4
13

Thanks for sharing your code! It seems that the code gets stuck when the "new" sheet (04_2023) consist new data in the list. So unfortunately the same problem remains: when the new sheet gets an update from the old sheet, the code just stops and doesn't continue. It actually randomly drops another Entry at line 423 but every other line remains empty. If I use this code with a more simple list of only 30 rows, it works perfectly! If it doesn't find a match, it just skips the row (as it is supposed to) and continues to enter the remaining rows until the end of the list. I just don't get it.. – Blackjack Apr 29 '23 at 09:38
@Blackjack how different is `Worksheets("04_2023")` when it has new data? – k1dr0ck Apr 30 '23 at 02:26
Both tables are almost the same. In the "new table" (04-2023) a few new rows are added. Therefore I want to take the new table and add the data (comments) from the "old table". – Blackjack Apr 30 '23 at 20:24
@Blackjack cant see your data structure so i cant figure out how to adjust the code – k1dr0ck May 01 '23 at 07:09
no problem at all ... I have now solved my challenge with formulas. Thanks for the numerous feedbacks – Blackjack May 03 '23 at 19:20

Excel VBA copy cells (after comparison)

1 Answers1