View Full Version : [SOLVED:] Copy and paste data and format if values match between sheets
Zlerp
10-14-2014, 01:34 PM
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
What is supposed to happen if a value on "My Sheet" is not on "New Property"?
Zlerp
10-15-2014, 11:02 AM
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
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
10-17-2014, 10:12 AM
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!
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
10-20-2014, 06:27 AM
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!
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
10-21-2014, 12:56 PM
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
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
10-22-2014, 10:25 AM
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
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?
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.