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

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