VBA - Script to search and replace values in rows between sheets based on criteria

[RobertHamberg]

I want ascript to search for the values in column A in sheet 1 and try to find a match in column A in Sheet 2. If a match is found I want the script to copy the values in column F-J in sheet 1 and add those values to column F-J in sheet 2 on the matching rows. Anyone able to help?

Sheet 1

A B C D E F G H I J 1 Name Owner Start End Time (H) Team R1 % R2 % 2 Test2 Owner2 2018-01-01 2018-12-31 200 Team2 Resurs2 100 0 0 3 Test3 Owner3 2018-01-01 2018-12-31 300 Team3 Resurs3 100 0 0 4 Test5 Owner5 2018-01-01 2018-12-31 500 Team5 Resurs5 100 0 0 5 Test6 Owner6 2018-01-01 2018-12-31 600 Team6 Resurs6 75 Resurs3 25 6 Test8 Owner8 2018-01-01 2018-12-31 800 Team8 Resurs8 50 Resurs7 50 7 Test10 Owner10 2018-01-01 2018-12-31 1 000 Team10 Resurs10 50 Resurs9 50 <tbody> </tbody>

<tbody>
</tbody>

Sheet 2

A B C D E F G H I J 1 Name Owner Start End Time (H) Team R1 % R2 % 2 Test1 Owner1 2018-01-01 2018-12-31 100 3 Test2 Owner2 2018-01-01 2018-12-31 200 4 Test3 Owner3 2018-01-01 2018-12-31 300 5 Test4 Owner4 2018-01-01 2018-12-31 400 6 Test5 Owner5 2018-01-01 2018-12-31 500 7 Test6 Owner6 2018-01-01 2018-12-31 600 8 Test7 Owner7 2018-01-01 2018-12-31 700 9 Test8 Owner8 2018-01-01 2018-12-31 800 10 Test9 Owner9 2018-01-01 2018-12-31 900 11 Test10 Owner10 2018-01-01 2018-12-31 1 000 <tbody> </tbody>

<tbody>
</tbody>

 

[Fluff]

Hi & welcome to the board.
Are the col A values on sheet1 unique?

 

[RobertHamberg]

Hi & welcome to the board.
Are the col A values on sheet1 unique?

Values in col A are unique in both sheet1 and sheet2. I have a script that selects certain rows in sheet1 and copy them to sheet2, then a script that adds values to rows in sheet2. Now I need a script that copy those values from sheet2 back to sheet1 on matching rows

 

[Fluff]

How about

Sub CopyCols()

   Dim Cl As Range
   Dim Sht1 As Worksheet
   Dim Sht2 As Worksheet
   
   Set Sht1 = Sheets("Sheet1")
   Set Sht2 = Sheets("Sheet2")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Sht1.Range("A2", Sht1.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 5).Resize(, 5)
      Next Cl
      For Each Cl In Sht2.Range("A2", Sht2.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then Cl.Offset(, 5).Resize(, 5).Value = .Item(Cl.Value).Value
      Next Cl
   End With

End Sub

 

[vds1]

Without loop

Sub CopyPaste()
    Dim LastRow     As Long
    Sheets("Sheet2").Select
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("F2").Formula = "=IFERROR(VLOOKUP($A2,Sheet1!$A:$J,COLUMN(),0),"""")"
    Range("F2").Copy
    With Range("F2:J" & LastRow)
        .PasteSpecial xlPasteFormulas
        .Copy
        .PasteSpecial xlPasteValues
    End With
End Sub

 

[Fluff]

Or a slightly simpler (and corrected, missing a = sign) version vds1 code

Sub CopyPaste()
    Dim LastRow     As Long
    With Sheets("Sheet2")
      LastRow = .Range("A" & Rows.Count).End(xlUp).Row
      With .Range("F2:J" & LastRow)
         .Formula = "=IFERROR(VLOOKUP($A2,Sheet1!$A:$J,COLUMN(),0),"""")"
         .Value = .Value
      End With
   End With
End Sub

 

[RobertHamberg]

Thanks alot for the help!

 

[Fluff]

Glad we could help.

 

[RobertHamberg]

I need help to re-write this script. I need it to do the following. Match value in column A in Sheet 1 with value in column A in Sheet 2, if match found I want the script to copy and replace the row on sheet 2 with the row from sheet 1.

I want it to work no matter the amount of columns and rows that contain data in sheet 1 and sheet 2.

Thanks in advance!

Sheet 1

A B C D E F G H I J 1 Name Owner Start End Time (H) Team R1 % R2 % 2 Test2 Owner2 2018-01-01 2018-12-31 200 Team2 Resurs2 100 <tbody> </tbody>

<tbody>
</tbody>

Sheet 2

A B C D E F G H I J 1 Name Owner Start End Time (H) Team R1 % R2 % 2 Test1 Owner1 2018-01-01 2018-12-31 100 Team2 Resurs2 25 Resurs2 75 3 Test2 Owner2 2018-01-01 2018-12-31 200 Team2 Resurs6 100 Resurs4 0 4 Test3 Owner3 2018-01-01 2018-12-31 300 Team2 Resurs2 50 Resurs1 50 5 Test4 Owner4 2018-01-01 2018-12-31 400 Team2 Resurs2 75 Resurs3 25 6 Test5 Owner5 2018-01-01 2018-12-31 500 Team25 Resurs2 80 Resurs6 20 <tbody> </tbody>

<tbody>
</tbody>

 

[Fluff]

Maybe

Sub CopyPaste()
    Dim UsdRws As Long
    Dim UsdCols As Long
    With Sheets("Sheet2")
      UsdRws = .Range("A" & Rows.Count).End(xlUp).Row
      UsdCols = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
      With .Range("B2", .Cells(UsdRws, UsdCols))
         .Formula = "=IFERROR(VLOOKUP($A2,Sheet1!$1:$" & UsdRws & ",COLUMN(),0),"""")"
         .Value = .Value
      End With
   End With
End Sub