Compare and copy adjacent cell if cells match of the same field in 2 Separate Worksheets

[tkoby11]

Between 2 versions of the same spreadsheets (with some new data each new successive version), where column B cells or "Description" field are the same I want to copy the adjacent cell value (Column A or "Code") from Column A in sheet 1 to column A in sheet 2.

In worksheet 1, I have:

column A column B

Code	Description
KS0001	A Los Vinateros Bravos, Pipeno Blanco 2020 1L
KS0002	Adrien Renoir, Le Terroir Extra Brut NV

In worksheet 2, I want to copy the text in the column "Code" for the same row where the Description is the same:

column A column B

Code	Description
(I need KS0002 here)	Adrien Renoir, Le Terroir Extra Brut NV
KSxxxx	Adroît, Mourvedre 2019

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your two sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Gmoney69]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your two sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

Sub CopyCode()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, srcRng As Range, srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    v = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set srcRng = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp))
    For i = 1 To UBound(v)
        If Not IsError(Application.Match(v(i, 2), srcRng, 0)) Then
            x = Application.Match(v(i, 2), srcRng, 0)
            With desWS.Range("A" & x + 1)
                .Value = v(i, 1)
                .Interior.ColorIndex = srcWS.Range("B" & i + 1).Interior.ColorIndex
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Right now this code copies notes and colors from Column A into Column A on the new sheet based on column B. My Document Numbers in Column B contain duplicates but each row has a Line Number in Column C which indicates a certain line of the document. I need it to take into account columns B and C together.

Current Macro Spits this out.
Old sheet says:

open	3001​	1​
confirmed	3001​	2​

New sheet after Running the Macro:

open	3001​	1​
	3001​	2​

What I need:
Old Sheet:

open	3001​	1​
confirmed	3001​	2​

New Sheet after Running the Macro:

open	3001​	1​
confirmed	3001​	2​

Here's a example of the data I'm dealing with. Of course the notes are a lot more detailed and there's more information on the reports but these are the only relevant columns. Report_Macro_EX.xlsx

 

[mumps]

Try:

Sub CopyCode()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, i As Long, val As String, srcWS As Worksheet, desWS As Worksheet, dic As Object
    Set srcWS = Sheets("11.28.22")
    Set desWS = Sheets("New Report")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    v2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v1)
        val = v1(i, 2) & "|" & v1(i, 3)
        If Not dic.exists(val) Then
            dic.Add val, v1(i, 1) & "|" & i + 1
        End If
    Next i
    For i = 1 To UBound(v2)
        val = v2(i, 1) & "|" & v2(i, 2)
        If dic.exists(val) Then
            With desWS.Range("A" & i + 1)
                .Value = Split(dic(val), "|")(0)
                .Interior.ColorIndex = srcWS.Range("B" & Split(dic(val), "|")(1)).Interior.ColorIndex
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Gmoney69]

Try:

Sub CopyCode()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, i As Long, val As String, srcWS As Worksheet, desWS As Worksheet, dic As Object
    Set srcWS = Sheets("11.28.22")
    Set desWS = Sheets("New Report")
    v1 = srcWS.Range("A2", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    v2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 2).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v1)
        val = v1(i, 2) & "|" & v1(i, 3)
        If Not dic.exists(val) Then
            dic.Add val, v1(i, 1) & "|" & i + 1
        End If
    Next i
    For i = 1 To UBound(v2)
        val = v2(i, 1) & "|" & v2(i, 2)
        If dic.exists(val) Then
            With desWS.Range("A" & i + 1)
                .Value = Split(dic(val), "|")(0)
                .Interior.ColorIndex = srcWS.Range("B" & Split(dic(val), "|")(1)).Interior.ColorIndex
            End With
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Awesome. That’s exactly what I needed. Thank you.

 

[mumps]

You are very welcome.