Compare columns in 2 sheets and then return a value in another column

Hi,

I have attached my excel spreadsheet which I have been trying to develop. The problem I have is as follows:

I have an old list or organizations. A system generates a new list of organizations however it does not produce the Owner column.

I have an old list of organizations which I need to compare monthly to a new list of organizations to highlight differences and identify the owner in the new list organizations.

Ignore the conditional formatting - I think I have found a formula to highlight the differences whereby a comparison is made and a value appears in the ACTION column.

I need a formula which:

1. Compares the org code in the new list to the org code in old list to check if they match.
2. if the org codes in both sheets match, the OWNER column in the NEW sheet should be populated with the value from the OWNER column in the OLD sheet.
3. if the org codes do not match no value should appear in the OWNER Column of the new sheet.

Any help would be appreciated.

Try this code:

Public Sub Pass1()
   Dim Ary As Variant
   Dim i As Long
   Dim Dest As Range
   Dim las As Long
   
   With Sheets("New")
        Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
        Set Dest = Range("D2")
        las = .Cells(Rows.Count, "D").End(xlUp).Row
        Range("D2:D" & las).Value = ""
        .Activate
   End With
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(Ary)
            .Item(Ary(i, 1)) = Empty
        Next i
        With Sheets("old")
            Ary = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value2
        End With
        For i = 2 To UBound(Ary)
            If .Exists(Ary(i, 1)) Then .Remove Ary(i, 1)
        Next i
      Ary = .keys
    End With
    Sheets("old").Activate
    Set Dest = Dest.Resize(UBound(Ary) + 1, 1)
    Dest.Value = Application.Transpose(Ary)
    'MsgBox Join(Ary)
      
    Call pass2
    
End Sub
Public Sub pass2()
   Dim Ary As Variant
   Dim i, la As Long
   Dim Dest As Range
   
   With Sheets("old")
        Ary = .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Value2
        Set Dest = Range("D2")
   End With
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(Ary)
            .Item(Ary(i, 1)) = Empty
        Next i
        With Sheets("old")
            .Activate
            la = .Cells(Rows.Count, "D").End(xlUp).Row
            Range("D2:D" & la).Value = ""
        End With
        With Sheets("new")
            Ary = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value2
        End With
        For i = 1 To UBound(Ary)
            If .Exists(Ary(i, 1)) Then .Remove Ary(i, 1)
        Next i
      Ary = .keys
    End With


    Set Dest = Dest.Resize(UBound(Ary) + 1, 1)
    Dest.Value = Application.Transpose(Ary)
    MsgBox Join(Ary)
   
End Sub

Hi,

Thank you. I tried the code but I just get a msgbox that appears stating the number 4.

Not sure if you have mis-understood my requirement. Sorry if comes across as confusing.

I just need a formula that will check to see if the org codes match on both sheets and then populate the 'owner' column in the sheet NEW with whatever is populated in the owner column in sheet OLD. Thanks

Here is another attempt.

Option Explicit

Sub ChangeFilter()
Dim cel, rngw, clr, crno As Range
Dim old, nww As Worksheet
Dim lrO, lrN, lra, r, c As Long
Application.ScreenUpdating = False
Set old = ThisWorkbook.Sheets("old")
Set nww = ThisWorkbook.Sheets("new")

lrO = old.Range("A" & Rows.Count).End(xlUp).Row
lrN = nww.Range("A" & Rows.Count).End(xlUp).Row

Set crno = old.Range("A2:A" & lrO)
Set rngw = nww.Range("A2:A" & lrN)

r = 2
c = 2

For Each cel In rngw
    r = r + 1
    For Each clr In crno
        c = c + 1
        If clr = cel Then
            cel.Offset(0, 3) = "old"
            cel.Offset(0, 2) = clr.Offset(0, 2)
        End If
    Next clr
Next cel

For Each cel In crno
    r = r + 1
    For Each clr In rngw
        c = c + 1
        If clr = cel Then
            cel.Offset(0, 3) = "old"
        End If
    Next clr
Next cel

Application.ScreenUpdating = True

End Sub