VBA copy value from one workbook to another if value matches?

Question

I have the following workbook called master:

Column I     Column K
1234         
1222         
1111

I also have a workbook called slave:

Column J        Column R
1234            Ambient
1222            Ambient
1111            Chiller

When the user enters/pastes the number in column I on my master workbook, i want to check if the same number exists in my slave workbook in column J.

If it does, i want to copy the corresponding prodcut groups from column R over to my master workbook in column K.

The other problem is my slave workbook changes name from time to time, but will always contain the word 'Depot memo' like so:

Food Depot Memo
Drinks Depot Memo 01-19
etc.

I am trying to reference my slave workbook by checking if the file name contains 'depot memo'.

For some reason this is not working. Please can someone show me where i am going wrong?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = True
Dim Dic As Object, key As Variant, oCell As Range, i As Long
Dim w1 As Worksheet, w2 As Worksheet

If Not Intersect(Target, Range("I:I")) Is Nothing Then ' <-- run this code only if a value in cell C5 has change

    Application.EnableEvents = False
    Set Dic = CreateObject("Scripting.Dictionary")

    If Not Dic.exists(Target.Value) Then
        Dic.Add Target.Value, Target.Offset(1, 0).Value
    End If

    Dim wbInd   As Integer
    Dim wb2 As Workbook

    For wbInd = 1 To Workbooks.Count ' <-- loop through all open workbooks
        If Workbooks(wbInd).Name Like "Depot Memo*" Then '<-- check if workbook name contains "volumes"
            Set wb2 = Workbooks(wbInd)
            Exit For
        End If
    Next wbInd

     On Error GoTo message
    Set w2 = wb2.Sheets(1)

    With w2
        i = .Cells(.Rows.Count, "J").End(xlUp).Row
    End With

    For Each oCell In w2.Range("J6:J" & i)
        For Each key In Dic
            If oCell.Value = key Then
                Target.Offset(0, 2).Value = oCell.Offset(0, 8) '<-- put the the value in column F (offset 1 column) to cell C6 (one row offset)
            End If
        Next
    Next
End If

Application.EnableEvents = True
Exit Sub

message:
Exit Sub
End Sub

EDIT:

With the suggested code from @user3598756 i encounter this problem:

If the user copy and pastes these values, rather than typing them, the correct supplier number does not correspond with the item number in column I.

This is obviously not correct, since it should have a different supplier number for each different item number.

Answer 1

edited to handle multiple changed cells

one thing that doesn't work as you'd expect is :

Like "Depot Memo*

that would not detect neither "Food Depot Memo" nor "Drinks Depot Memo 01-19"

while you have to use

Like "*Depot Memo*"

Furthermore:

• there's no need for any Dictionary object

• you don't need to iterate with For Each oCell In w2.Range("J6:J" & i)

so I'd go with the following refactoring of your code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oCell As Range, targetCell As Range
    Dim ws2 As Worksheet

    If Not Intersect(Target, Range("I:I")) Is Nothing Then ' <-- run this code only if a value in column I has changed
        If Not GetWb("Depot Memo", ws2) Then Exit Sub

        With ws2
            For Each targetCell In Target
                Set oCell = .Range("J1", .Cells(.Rows.count, "J").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not oCell Is Nothing Then
                    Application.EnableEvents = False
                    targetCell.Offset(0, 2).Value = oCell.Offset(0, 8)
                    Application.EnableEvents = True
                End If
            Next
        End With
    End If
End Sub

Function GetWb(wbNameLike As String, ws As Worksheet) As Boolean
    Dim wb As Workbook
    For Each wb In Workbooks
        If wb.name Like "*" & wbNameLike & "*" Then '<-- check if workbook name contains "Depot Memo"
            Set ws = wb.Worksheets(1)
            Exit For
        End If
    Next
    GetWb = Not ws Is Nothing
End Function

Answer 2

The wildcard in "Depot Memo*" name check should appear at the beginning AND the end of the text. This would detect if a workbook name contains any text before and/or after "Depot Memo".

If Workbooks(wbInd).Name Like "*Depot Memo*" Then