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

Sheet 1
ID	Names	Place	Amount
11	Antony	Texas	231
22	Rodger	Mexico	-639
33	Marcos	USA	-300
44	Lily	Brazil	500

<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>
</tbody>

Sheet 2
ID	Names	Place	Amount
11	Antony	Brazil	231
11	Antony	USA	-231
44	Lily	Texas	500
33	Marcos	Mexico	-300
44	Lily	Hungary	-231
22	Rodger	Texas	639
22	Rodger	Hungary	-639

<colgroup><col span="2"><col><col></colgroup><tbody>
</tbody>

 

[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