If value in sheet1 column A is found in Sheet2 column A, Copy that whole row from sheet1 and replace the value in sheet2

[JaimeMabini]

Hello,

I am new on creating Excel VBA, any assistance would be highly appreciated.

I am trying to create a VBA that will read the entire Sheet1 and find matches in sheet2. If the value in sheet1 matches a value in sheet2 in any row order, copy the and replace the row found in sheet2 with the value from sheet1.

Example of what I am trying to do (note that the sheet contains massive data with formula on some cells)

Sheet1:

Row1	mm	Value1
Row2	mm	Value2
Row3	mm	Value3

Sheet2:

Row4	mm	Value4
Row1	mm	Value5
Row5	mm	Value6
Row3	mm	Value7

After running the VBA Code:

Sheet2:

Row4	mm	Value4
Row1	mm	Value1
Row5	mm	Value6
Row3	mm	Value3

Result is that Row1 and Row3 in sheet1 is found in sheet2, and therefore after running the code sheet2 will be updated with the value found in sheet1

 

[DanteAmor]

Hi and welcome to MrExcel.

Try this:

Sub UpdateSheet2()
  Dim i As Long
  Dim f As Range, c As Range
  
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    For Each c In .Range("A1", .Range("A" & Rows.Count).End(3))
      Set f = Sheets("Sheet1").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        f.EntireRow.Copy
        .Range("A" & c.Row).PasteSpecial xlValues
      End If
    Next
  End With
  Application.CutCopyMode = False
End Sub

 

[JaimeMabini]

Hello Dante!

Thank you for the warm welcome! and this is exactly what I am looking for. Big Thanks!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[JaimeMabini]

Hello Dante,

With this code of yours:

Sub UpdateSheet2()
  Dim i As Long
  Dim f As Range, c As Range
  
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    For Each c In .Range("A1", .Range("A" & Rows.Count).End(3))
      Set f = Sheets("Sheet1").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        f.EntireRow.Copy
        .Range("A" & c.Row).PasteSpecial xlValues
      End If
    Next
  End With
  Application.CutCopyMode = False
End Sub

Is there a way to limit the job to somehow create a dynamic range from an inputted value in sheet1 e.g. A3 that will stop the job in that range. For example, I inputted A3 in cell D1 in sheet1. The copy job to sheet2 will end or exit once the range A3 was meant despite having for example A500 rows.

Sheet1

	Column A	Column B	Column C
row 1	abc	1	A3
row 2	efg	12
row 3	hij	3
row 4	klm	4

Sheet2

Column A	Column B	Column C
abc	7
efg	8
hij	9
klm	10

Result of Sheet2 after running the code

abc	1
efg	12
hij	3
klm	10

In this example. Notice that the last row with attributes "klm" still has the same value from sheet2 ="10" despite having value sheet1="4" because we inputted a range A3 in Column C sheet1 and it was not included in the job. Also, I was hoping that when it reach the inputted range, it will exit the job.

I have this code that works with the range, it only copies the value up until the range I inputted. but the job doesn't end or exit automatically.

Sub UpdateSheet2()


  Dim i As Long
  Dim f As Range, c As Range
  Sheets("Sheet1").Select 'sheet where the inputted range is coming from
  last = Range("B19").Value 'cell where the inputted range is coming from
  
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    For Each c In .Range("A1", .Range("A" & Rows.Count).End(3))
      Set f = Sheets("Sheet1").Range("A1", last).Find(c.Value, , xlValues, xlWhole, , , False) 'I put the parameter here
      
      If Not f Is Nothing Then
        f.EntireRow.Copy
        .Range("A" & c.Row).PasteSpecial xlValues
        
      End If
    Next
  End With
  Application.CutCopyMode = False
  
End Sub

 

[amrubinissa]

Hey Dante,

Thanks for the code. I just registered just for this question which is important to me.

Kindly, Is there a way you can paste the whole cell but this time with its highlighted cells (Mine in yellow). So the problem it pastes the row without its format such as color (as some are highlighted) background color

This is the original cell

This is the cell after applying your code

Basicly, I need it move/replaced with the highlight please.

Looking forward for your replay,
Amru

 

[DanteAmor]

Hi @amrubinissa and welcome to MrExcel.

Is there a way you can paste the whole cell but this time with its highlighted cells

Try this

Sub UpdateSheet2()
  Dim i As Long
  Dim f As Range, c As Range
  
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    For Each c In .Range("A1", .Range("A" & Rows.Count).End(3))
      Set f = Sheets("Sheet1").Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
      If Not f Is Nothing Then
        f.EntireRow.Copy .Range("A" & c.Row)
      End If
    Next
  End With
  Application.CutCopyMode = False
End Sub

 

[amrubinissa]

Hey Dante

I genuinely appreciate it. It worked exactly the way I wanted to.

I wish you a happy day, what’s left of the day.

Many thanks
Amru

 

[amrubinissa]

Hi again Dante,

Sorry to bother, please I wanted to add one more thing to the code.

I want the whole row to be replaced not just if its match column A but also column J. So in order to completely replace the row, both column A cell and column J cells has to be the same.

Warms regards,
Amru

 

[amrubinissa]

Hope you are safe & well Dante

Simply stating what I'm looking for:

IF (cells in column A & J together in sheet 1) match (cells in columns A & J together in sheet 2) THEN replace whole sheet 2 row from sheet 2

Any idea how?