Copy and paste data and format if values match between sheets

[Zlerp]

Hello All,


I am looking for a macro that will look between 2 sheets and check if there are values that match in column A on 2 separate sheets in the same workbook. I need the macro to loop until the last row of data.

the values start at A4 and continue down to the last row in both sheets. The sheets are named "New Property" and "MySheet".

The Macro will compare column A on both sheets and if a value matches, then it will copy that row of data (format and all) from "MySheet" and paste it to the matching value row in "New Property". it will only copy and paste data from columns A:H.


So for example:
there are 2 sheets in the same workbook. One named "New Property" and one named "MySheet". If in the sheet "New Property", the value of cell A7 is "326578" and in the sheet "MySheet" the value of cell A14 is "326578" (matching values) then it will copy the Data and Format of A14:H14 from the sheet "MySheet" and paste it into A7:H7 on the sheet "New Property". the macro will do this for all matching values in column A (it needs to loop to last row).

Please let me know if you have any questions about this. All help is appreciated.

Thank you for your time,
Zlerp

[SamT]

What is supposed to happen if a value on "My Sheet" is not on "New Property"?

[Zlerp]

Hey first off thanks for your help.

If a value on "MySheet" is not on "New Property" then do not touch it. Do not add a new row of data to "New Property".

Thanks

[SamT]

Option Explicit

Sub Refresh_NewProperty_Sheet()
Dim NewDataRng As Range 'For My Sheet
Dim Cel As Range 'For My Sheet
Dim OldDataRng As Range 'For New Property
Dim MatchingValueCell As Range 'For New Property
Dim LastRow As Long

With Sheets("My Sheet")
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set NewDataRng = .Range("A4:A" & CStr(LastRow))
End With

With Sheets("New Property")
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set OldDataRng = .Range("A4:A" & CStr(LastRow))
End With

For Each Cel In NewDataRng
Set MatchingValueCell = OldDataRng.Find(What:=Cel.Value, _
After:=OldDataRng.Cells(OldDataRng.Cells.Count))
If Not MatchingValueCell Is Nothing Then _
Cel.Resize(1, 8).Copy MatchingValueCell
Next Cel

End Sub

[Zlerp]

Hey SamT, this works great! Thanks a lot for your help!

now if i also wanted to copy and past the columns M and N from "MySheet" to "New Property" if the value in column A matches on both sheets how would i add that to this code?

i really appreciate this!

[SamT]

Off the top of my head

If Not MatchingValueCell Is Nothing Then
Cel.Resize(1, 8).Copy MatchingValueCell
Cel.Offset(12).Resize(1, 2) Copy MartchingValueCell.Offset(12)
End If
Next Cel

I don't think so, but you might need to use

Cel.Cells(1).Offset(12).Resize(1, 2).Copy

[Zlerp]

Hey SamT So Column M did work but for some reason i cant get it to work for column N.

As of right now this is what the code looks like:

Option Explicit
Sub Refresh_NewProperty_Sheet()
Dim NewDataRng As Range 'For My Sheet
Dim Cel As Range 'For My Sheet
Dim OldDataRng As Range 'For New Property
Dim MatchingValueCell As Range 'For New Property
Dim LastRow As Long

With Sheets("MySheet")
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set NewDataRng = .Range("$A4:$A" & CStr(LastRow))
End With

With Sheets("New Property")
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set OldDataRng = .Range("$A4:$A" & CStr(LastRow))
End With

For Each Cel In NewDataRng
Set MatchingValueCell = OldDataRng.Find(What:=Cel.Value, _
After:=OldDataRng.Cells(OldDataRng.Cells.Count))
If Not MatchingValueCell Is Nothing Then _
Cel.Resize(1, 8).Copy MatchingValueCell
Next Cel

If Not MatchingValueCell Is Nothing Then
Cel.Resize(1, 8).Copy MatchingValueCell
Cel.Offset(13).Resize(1, 2).Copy MatchingValueCell.Offset(13)
End If


End Sub




How can i fix this so it also copies and pastes the value of column N from "MySheet" to "New Property" if that row contains a matching value in Column A on both sheets.


thank you again for your help!

[SamT]

Not sure.

Try
For Each Cel In NewDataRng
Set MatchingValueCell = OldDataRng.Find(What:=Cel.Value, _
After:=OldDataRng.Cells(OldDataRng.Cells.Count))
If Not MatchingValueCell Is Nothing Then
Cel.Resize(1, 8).Copy MatchingValueCell
Cel.Cells(1).Offset(13).Resize(1, 2).Copy MatchingValueCell.Offset(13)
End If
Next Cel

[Zlerp]

Hey SamT,

Still no luck with this.

I was thinking of a new way to go about this yet still having the same outcome. Is it possible to lock columns "I:L" from VBA and Human Editing.

Then il run the code but instead of copying A:H, it will copy A:N. This with the locked from editing columns should give me the same outcome.

how do i Lock columns "I:L" from Editing via VBA or Human.
How do i Unlock the columns so they can be edited once the macro is complete.

Once again thank you soo much! You have been more than enough help. Sorry for all the questions.

Thanks a lot,
Zlerp

[SamT]

My bad, I I should have given you the whole code.

From your post #5
now if i also wanted to copy and past the columns M and N from "MySheet" to "New Property" if the value in column A matches on both sheets how would i add that to this code?
Form your post #7
How can i fix this so it also copies and pastes the value of column N from "MySheet" to "New Property" if that row contains a matching value in Column A on both sheets.I am assuming that you still want to copy M & N



Option Explicit
Sub Refresh_NewProperty_Sheet()
Dim NewDataRng As Range 'For My Sheet
Dim Cel As Range 'For My Sheet
Dim OldDataRng As Range 'For New Property
Dim MatchingValueCell As Range 'For New Property
Dim LastRow As Long

With Sheets("MySheet")
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set NewDataRng = .Range("$A4:$A" & CStr(LastRow))
End With

With Sheets("New Property")
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Set OldDataRng = .Range("$A4:$A" & CStr(LastRow))
End With

For Each Cel In NewDataRng
Set MatchingValueCell = OldDataRng.Find(What:=Cel.Value, _
After:=OldDataRng.Cells(OldDataRng.Cells.Count))

If Not MatchingValueCell Is Nothing Then
Cel.Resize(1, 8).Copy MatchingValueCell
Cel.Offset(13).Resize(1, 2).Copy MatchingValueCell.Offset(13)
End If
Next Cel


End Sub

[Zlerp]

Hey,

I ended up fixing this by writing another macro that just moves M and N right after H so i dont have to worry about skipping Columns I:L. Thank you for your help! you helped make my life about 30 minutes a day easier!! :beerchug:

thanks again,
Zlerp

[SamT]

moves M and N right after H so i dont have to worry about skipping Columns I:L.

No wonder I couldn't get it right! That is not what you said you wanted.:po:

Did you even try my last suggestion?