look for ID in 2 sheets and map details

[kshitij_dch]

Hi,

I have a workbook in which sheet 1 has few ID and name with details and sheet 2 is having list of ID and name with details .

Looking for a macro which will match the ID in sheet1 with sheet2 , if ID matches then look for the amount in column D if amount is same in both the sheets then copy the place and name from sheet 2 to sheet1

[TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 256, colspan: 4"]Sheet 1[/TD]
[/TR]
[TR]
[TD="class: xl63"]ID[/TD]
[TD="class: xl63"]Names[/TD]
[TD="class: xl63"]Place [/TD]
[TD="class: xl63"]Amount[/TD]
[/TR]
[TR]
[TD="class: xl63"]11[/TD]
[TD="class: xl63"]Antony[/TD]
[TD="class: xl63"]Texas[/TD]
[TD="class: xl63"]231[/TD]
[/TR]
[TR]
[TD="class: xl63"]22[/TD]
[TD="class: xl63"]Rodger[/TD]
[TD="class: xl63"]Mexico[/TD]
[TD="class: xl63"]-639[/TD]
[/TR]
[TR]
[TD="class: xl63"]33[/TD]
[TD="class: xl63"]Marcos[/TD]
[TD="class: xl63"]USA[/TD]
[TD="class: xl63"]-300[/TD]
[/TR]
[TR]
[TD="class: xl63"]44[/TD]
[TD="class: xl63"]Lily[/TD]
[TD="class: xl63"]Brazil[/TD]
[TD="class: xl63"]500
[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="width: 250"]
<colgroup><col span="2"><col><col></colgroup><tbody>[TR]
[TD="colspan: 4"]Sheet 2[/TD]
[/TR]
[TR]
[TD]ID[/TD]
[TD]Names[/TD]
[TD]Place [/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Antony[/TD]
[TD]Brazil[/TD]
[TD]231[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Antony[/TD]
[TD]USA[/TD]
[TD]-231[/TD]
[/TR]
[TR]
[TD]44[/TD]
[TD]Lily[/TD]
[TD]Texas[/TD]
[TD]500[/TD]
[/TR]
[TR]
[TD]33[/TD]
[TD]Marcos[/TD]
[TD]Mexico[/TD]
[TD]-300[/TD]
[/TR]
[TR]
[TD]44[/TD]
[TD]Lily[/TD]
[TD]Hungary[/TD]
[TD]-231[/TD]
[/TR]
[TR]
[TD]22[/TD]
[TD]Rodger[/TD]
[TD]Texas[/TD]
[TD]639[/TD]
[/TR]
[TR]
[TD]22[/TD]
[TD]Rodger[/TD]
[TD]Hungary[/TD]
[TD]-639[/TD]
[/TR]
</tbody>[/TABLE]

 

[Fluff]

Are the IDs in sheet 1 unique?

 

[kshitij_dch]

yes they are

 

[Fluff]

In that case, try

Sub MatchIDUpdate()

   Dim Cl As Range
   Dim Ws1 As Worksheet
   Dim Ws2 As Worksheet
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("Sheet2")
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Application.Transpose(Application.Transpose(Cl.Offset(, 1).Resize(, 3)))
      Next Cl
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then
            Debug.Print .Item(Cl.Value)(3)
            If .Item(Cl.Value)(3) = Cl.Offset(, 3).Value Then Cl.Offset(, 1).Resize(, 2).Value = .Item(Cl.Value)
         End If
      Next Cl
   End With
   
End Sub

 

[kshitij_dch]

Thanks and if in case in sheet 1 id's are not unique but the amount is then ?

 

[Fazza]

For info, another approach is to use a query. ALT-D-N-N and follow the wizard. If you receive a message about no visible tables choose options & then 'system tables' to then be able to choose a worksheet name as a data source. From the last step of the wizard you can choose to edit the SQL. Enter the below SQL to define the query. This is the manual set up, if using VBA there are alternative approaches - such as ADO instead of a query table. This sort of approach can be handy sometimes.

UPDATE [Sheet2$] S2 INNER JOIN [Sheet1$] S1 ON S2.Names = S1.Names AND S2.Amount = S1.Amount
SET S2.Names = S1.Names, S2.Place = S1.Place

 

[kshitij_dch]

Thanks Fazza , it is a great info indeed but if in case i would need changes to the above code that Fluff has provided , when sheet 1 id's are not unique but the amount is then what changes to be made to the above code?

 

[Fazza]

Apologies, I was wrong earlier. The SQL I gave wrongly matched on Names instead of ID. To correct, please change "Names" to "ID" on the first row

UPDATE [Sheet2$] S2 INNER JOIN [Sheet1$] S1 ON S2.ID = S1.ID AND S2.Amount = S1.Amount
SET S2.Names = S1.Names, S2.Place = S1.Place

This already handles when ID entries are not unique. For modifying Fluff's code, I'll leave that to Fluff.
For coding a query solution what is the Excel version?

 

[Fazza]

please modify as required. cheers

Sub example()

    Dim sConn As String
    Dim sSQL As String
    
    Dim rs As Object
    
    '----------------------------
    'Use the connection string for your Excel version. Refer https://www.connectionstrings.com/excel/
    'This string for Excel 2013 *.xlsb
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    '----------------------------
         
    sSQL = Join$(Array( _
         "UPDATE [Sheet2$] S2 INNER JOIN [Sheet1$] S1 ON S2.ID = S1.ID", _
         "SET S2.Names = S1.Names, S2.Place = S1.Place", _
         "WHERE S2.Amount = S1.Amount"), vbCr)
    
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sSQL, sConn
    Set rs = Nothing
    
End Sub

 

[kshitij_dch]

Thanks Fazza , I have Excal 2010 , showing error when i run the code in excel "Syntex Error in Update Statement" rs.Open sSQL, sConn

I have modified the code like

 Dim sConn As String
    Dim sSQL As String
    
    Dim rs As Object
    
    '----------------------------
    'Use the connection string for your Excel version. Refer https://www.connectionstrings.com/excel/
    'This string for Excel 2013 *.xlsb
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"
    '----------------------------
         
    sSQL = Join$(Array( _
         "UPDATE [Sheet2$] S2 INNER JOIN [Sheet1$] S1 ON S2.ID = S1.ID", _
         "SET S2.Risk = S1.Risk, S2.Income Category = S1.Income Category", _
         "WHERE S2.Amount = S1.Amount"), vbCr)
    
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sSQL, sConn
    Set rs = Nothing