PDA

View Full Version : copy entire row from sheet1 into sheet2 if ID matches and column header should match



dileepkmr3
03-10-2018, 08:08 AM
Sheet1
ID First Last Street City State Zip
---- -------- ---- -------------------- ----------- ---- -----
51 Alfred Obrien 636 Charla Lane Richardson TX 75081
52 Donald Lemmons 4956 Center Street Umatilla OR 97882
53 Corrine McCann 3149 West Street Grand Rap MI 49546
54 Monique Gavin 4078 Maryland Largo FL 34640
55 Steven Murray 965 Tree Top Lane Lansdowne PA 19050
56 Kelley Robins 1191 Earnhardt Louisville KY 40223

Sheet2
ID Zip State Last City first Street Zip
---- ---- ------ ------ ------ ----- ------- ---
56
51
87
52
55
53
54

need to copy the data row wise depends on ID(unique) if ID matches copy and paste the entire row at the same time column header should match. if you observe column headers are same but position is different in sheet2.

SamT
03-10-2018, 01:24 PM
For each Cel in Sheet, ID
Set Found = Sheet2, ID.Find(Cel)
If Found is Nothing then Goto the Next Cel
Array = Cel.Resize(1, 7).Value
With Found.Resize(1, 8)

.Cells(1-ID) = Array(1-ID)
.Cells(2-Zip) = Array(7-Zip)
.Cell(3-Etc = Array(6-Etc)
Etc,etc,etc
.Cells(8-Zip) = Array(7-Zip)


End With
Next Cel

mana
03-10-2018, 05:40 PM
Option Explicit


Sub test()
Dim r As Range

Set r = Sheets("Sheet2").Cells(1).CurrentRegion
Set r = Intersect(r, r.Offset(1))

r.Columns(2).Formula = "=iferror(vlookup(A2,sheet1!A:G,7,0),"""")"
r.Columns(3).Formula = "=iferror(vlookup(A2,sheet1!A:G,6,0),"""")"
r.Columns(4).Formula = "=iferror(vlookup(A2,sheet1!A:G,3,0),"""")"
r.Columns(5).Formula = "=iferror(vlookup(A2,sheet1!A:G,4,0),"""")"
r.Columns(6).Formula = "=iferror(vlookup(A2,sheet1!A:G,5,0),"""")"
r.Columns(7).Formula = "=iferror(vlookup(A2,sheet1!A:G,2,0),"""")"
r.Columns(8).Formula = "=if(B2="""","""",B2)"
r.Value = r.Value

End Sub



マナ

dileepkmr3
03-18-2018, 07:26 AM
i already had vlookup formula but the problem here is the data should not overwrite in the cell for which ID not matches...i dont want to display nothing.. if it doesnot match it should not change cell data.. like cell contains some text .if it doesnot match with ID, it should reflect the data contains in that cell

dileepkmr3
03-18-2018, 07:28 AM
i didnt understand..do u hav an sample code ??

MickG
03-19-2018, 06:00 AM
Try this:-



Sub MG19Mar42
Dim Dn As Range
Dim Rng As Range
Dim Dic As Object
Dim R As Range
Dim Lst As Long
Dim ac As Long

With Sheets("Sheet1")
Set Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
For Each Dn In Rng
If Not Dic.exists(Dn.Value) Then
Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
End If
For ac = 1 To Lst
Dic(Dn.Value).Item(.Cells(1, ac + 1).Value) = Dn.Offset(, ac).Value
Next ac
Next Dn
End With


With Sheets("Sheet2")
Set Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
Lst = .Cells("1", Columns.Count).End(xlToLeft).Column
For Each Dn In Rng
If Dic.exists(Dn.Value) Then
For ac = 1 To Lst
Dn.Offset(, ac).Value = Dic(Dn.Value).Item(.Cells(1, ac + 1).Value)
Next ac
End If
Next Dn
End With
With Rng.Offset(-1).Resize(Rng.Count + 1, Lst)
.Borders.Weight = 2
.Columns.AutoFit
End With
End Sub

Before:- Sheet1 Starting "A1"
https://public.boxcloud.com/api/2.0/files/283609022461/content?preview=true&version=298394670877&access_token=1!uhQjd0X62oKYRHx_nodszENEqD5gJeY_Dse7xV2OEEMWYUgpavgQQ2CyilL4 s9DttnOvzotHTxP53Pu50sAvWN-5w8kfMYm1_gmhoR_zseubcn48q3aqnBPEKMHuOZcg9LIhzsgbp0m5HZMG1QgRBp7p5ScAUdfUB6 vOPaBz3jTYdfsM8aJQd8b_9Y7JOFR2qLkegRNenI9BU5XgnyhHODs_qRFKjqcuAjH3qhvitM82g cBzE-a0srJAwNXHVoCHFy_XmDEo9tJjnm9ms4YiacjqfNWfBukkIQT-CQCckdO0MVdaDgFqvqYUJ2b8cWC3qi6DYKJEiVgH7wX_uxT2G2E5uuZlEJn4y3v9mTmz5OkrJC9 fnhS3c4zTL7xcJrqJ8oq384JY0xVE4szq&box_client_name=box-content-preview&box_client_version=1.34.0



After Sheet2 starting"A1":-
https://public.boxcloud.com/api/2.0/files/73691114177/content?preview=true&version=298399050691&access_token=1!7h6DBaAfzwqijIjFK-4CQyNEZvA3DVhCP3JyVeaCIbddGJWMO-_myc6lVGeCnVybn02RsE48wRbA5M-A9yCHJIXUSE5bHx2jeNi_CmnDOhkXOhKTePb9jVFUeTt3QW0FEL-q4RhVXQEXX71QZKdY0k2lAB4KgFDp8yj8kKIFwtCz4W3KiVvUgPcYwNILLBMgg5ou11655L_u6V N6dx5xLm84YFDsKyZ24zfayUsqBuOnLRIAnOUxWYdzoTp-bihlEhkVz0YkhNfq6XBCFEZwUAjx1qoyucqIygCKUYF7ZHCVmxpuicsO1K5UVkXSWIf0OdQ_spa kDB5ONx5iMqpVE0ZE4zB7Vq225fdU20mNS5MobVXayUS8HuzOYMajq595Idk2CP5u5HNbQ9k.&box_client_name=box-content-preview&box_client_version=1.34.0


Regards Mick

dileepkmr3
03-21-2018, 04:56 AM
Mick G.You are awesome bro:bow:. this works 100% perfectly for me. thank u so much for that.:thumb

MickG
03-21-2018, 06:50 AM
You're welcome