copy entire row from sheet1 into sheet2 if ID matches and column header should match

[dileepkmr3]

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]

• 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]

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]

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]

i didnt understand..do u hav an sample code ??

[MickG]

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"




After Sheet2 starting"A1":-



Regards Mick

[dileepkmr3]

Mick G.You are awesome bro. this works 100% perfectly for me. thank u so much for that.

[MickG]

You're welcome