Copy data from one sheet to another based on matching cells

[cahedger]

Hey Everybody,

So I am trying to make a macro that goes to the last row of sheet 1, takes the value in column F (PID)... and if it finds any matches in sheet 2 (column A)... copies the values in columns E, F, N & O (SID, Store Name, Total & Total Stock) from the corresponding row in sheet 2 and pastes it in a new row above the the matching PID in Column I - L (SID, Store, Total & Total Stock) of sheet 1. After that, it should continue up the spreadsheet repeating until it gets to the headers and then stop. I've included the sheets below... Thank you sooo much in advance for anybody that can help.


Sheet 1:

A	B	C	D	E	F	G	H	I	J	K	L
Manager	VID	Vendor	Order Name	Total Goal	PID	Start Date	End Date	SID	Store	Total	Total Stock
Jdoe	34978	Vendor 3	Order Name 4	500	17864	7/20/2015	9/1/2015
Mfreeman	36785	Vendor 2	Order Name 3	250	17863	6/17/2015	7/30/2015
Rdawson	39867	Vendor 4	Order Name 2	25	18534	7/15/2015	8/15/2015
Tcruise	35487	Vendor 1	Order Name 1	150	11594	7/1/2015	9/1/2015

<tbody>
</tbody>

Sheet 2:

A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
PID	Product	VID	Vendor	SID	Store	Price	Margin	Daily	DailyStock	Monthly	Monthly Stock	Monthly %	Total Sales	Total Stock
11594	Product 1	35487	Vendor 1	24876	Store 1	5	10%	0	0	0	0	0	20	50
11594	Product 1	35487	Vendor 1	24698	Store 2	5	10%	0	0	0	0	0	15	20
17863	Product 2	36785	Vendor 2	24678	Store 3	10	10%	0	0	0	0	0	100	100
17863	Product 2	36785	Vendor 2	21123	Store 4	10	15%	0	0	0	0	0	27	30
11594	Product 1	35487	Vendor 1	21124	Store 5	5	10%	0	0	0	0	0	41	50
17864	Product 3	34978	Vendor 3	22485	Store 6	15	10%	0	0	0	0	0	15	20
17487	Product 4	39867	Vendor 4	26578	Store 7	20	15%	0	0	0	0	0	87	100
17487	Product 4	39867	Vendor 4	23754	Store 8	20	10%	0	0	0	0	0	50	50
17864	Product 3	34978	Vendor 3	25746	Store 9	15	15%	0	0	0	0	0	72	75
17864	Product 3	34978	Vendor 3	21212	Store 10	15	20%	0	0	0	0	0	15	25
18534	Product 5	39867	Vendor 4	26589	Store 11	25	10%	0	0	0	0	0	10	10

<tbody>
</tbody>

 

[JLGWhiz]

You have more than one occurence of the PID number in sheet 2. How do you want to handle that? Take latest date only or copy values for all occurences and post to sheet 1?

 

[cahedger]

Thank you so much for the quick response... yes, if we can copy the values for all occurrences above the matching PID in sheet one that would be awesome. Thanks again

 

[cahedger]

Sorry... meant to say if we can paste the values for all occurrences above the the matching PID in sheet one.

 

[JLGWhiz]

this seemed to do what you want. It tested without error, but you should test it just to be sure before applying it to your original file.

Sub CopyMoreStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, i As Long, fn As Range, fAdr As String
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
lr = sh1.Cells(Rows.Count, 6).End(xlUp).Row
Set rng = sh2.Range("A2", sh2.Cells(Rows.Count, 1).End(xlUp))
    For i = lr To 2 Step -1
        With sh1
            Set fn = rng.Find(.Cells(i, 6).Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    fAdr = fn.Address
                    Do
                        .Rows(i).Insert
                        .Cells(i, 9) = sh2.Range("E" & fn.Row).Value
                        .Cells(i, 10) = sh2.Range("F" & fn.Row).Value
                        .Cells(i, 11) = sh2.Range("N" & fn.Row).Value
                        .Cells(i, 12) = sh2.Range("O" & fn.Row).Value
                        Set fn = rng.FindNext(fn)
                    Loop While fn.Address <> fAdr
                End If
        End With
    Next
End Sub

 

[cahedger]

Hey JLGWhiz... thanks again for your help and jumping in so quick. The code threw me an error at first, but once I added in "Rng As Range" into the variables it seemed to work great. Here's the edited code in case anybody else needs it.

Sub CopyMoreStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, i As Long, fn As Range, fAdr As String, [B]Rng As Range[/B]
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
lr = sh1.Cells(Rows.Count, 6).End(xlUp).Row
Set Rng = sh2.Range("A2", sh2.Cells(Rows.Count, 1).End(xlUp))
    For i = lr To 2 Step -1
        With sh1
            Set fn = Rng.Find(.Cells(i, 6).Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    fAdr = fn.Address
                    Do
                        .Rows(i).Insert
                        .Cells(i, 9) = sh2.Range("E" & fn.Row).Value
                        .Cells(i, 10) = sh2.Range("F" & fn.Row).Value
                        .Cells(i, 11) = sh2.Range("N" & fn.Row).Value
                        .Cells(i, 12) = sh2.Range("O" & fn.Row).Value
                        Set fn = Rng.FindNext(fn)
                    Loop While fn.Address <> fAdr
                End If
        End With
    Next
End Sub

Thanks a million, you guys on this forum are the best.

 

[JLGWhiz]

Hey JLGWhiz... thanks again for your help and jumping in so quick. The code threw me an error at first, but once I added in "Rng As Range" into the variables it seemed to work great. Here's the edited code in case anybody else needs it.

Sub CopyMoreStuff()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, i As Long, fn As Range, fAdr As String, [B]Rng As Range[/B]
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
lr = sh1.Cells(Rows.Count, 6).End(xlUp).Row
Set Rng = sh2.Range("A2", sh2.Cells(Rows.Count, 1).End(xlUp))
    For i = lr To 2 Step -1
        With sh1
            Set fn = Rng.Find(.Cells(i, 6).Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    fAdr = fn.Address
                    Do
                        .Rows(i).Insert
                        .Cells(i, 9) = sh2.Range("E" & fn.Row).Value
                        .Cells(i, 10) = sh2.Range("F" & fn.Row).Value
                        .Cells(i, 11) = sh2.Range("N" & fn.Row).Value
                        .Cells(i, 12) = sh2.Range("O" & fn.Row).Value
                        Set fn = Rng.FindNext(fn)
                    Loop While fn.Address <> fAdr
                End If
        End With
    Next
End Sub

Thanks a million, you guys on this forum are the best.

Sorry about that,
Regards, JLG

 

[cahedger]

Hey JLG,

No worries, that macro worked great. One (hopefully really easy) question... I'm putting that macro to use... but working on a new one as well. Could you tell me what part of that formula I would alter to make it insert a row below matches instead of above them... sorry I've spent hours trying to figure it out. Thanks again for all your help, I went ahead and added some likes to your posts.