vba copy corresponding values from another workbook? - vba

Question

I have two workbooks:
Planner
Column K Column AG
123 £100
246 £20
555 £80
Master
Column D Column R
123 £100
246 £20
555 £80
I am trying to copy the values from Planner, Column AG into Column R (Master) where my item numbers in Column D (Master) match with column K (Planner).
My code below produces no error and it is not producing any results - despite their being several matches.
Please can someone show me where i am going wrong?
For the avoidance of doubt, my workbook is definitely opening ok so is finding the file.
Code:
Sub PlannerOpen()
'Set Variables
Dim wb2 As Workbook
Dim i As Long
Dim j As Long
Dim lastRow As Long
Dim app As New Excel.Application
'Find Planner
If Len(FindDepotMemo) Then
'If Found Then Set Planner Reference.
app.Visible = False 'Visible is False by default, so this isn't necessary
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wb2 = Workbooks.Open(FindDepotMemo, ReadOnly:=True, UpdateLinks:=False)
'If We have our planner lets continue...
'With my workbook
With wb2.Worksheets(1)
lastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
'Lets begin our data merge
j = 2
For i = 2 To lastRow
'If data meets criteria
'Check Planner For Turnover
If ThisWorkbook.Worksheets("Data").Range("D" & j).Value = .Range("K" & i).Value Then ' check if Item number matches
ThisWorkbook.Worksheets("Data").Range("R" & j).Value = .Range("AG" & i).Value
j = j + 1
End If
'Continue until all results found
Next i
End With
'All Done, Let's tidy up
'Close Workbooks
'wb2.Close SaveChanges:=False
'app.Quit
'Set app = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub
Function FindDepotMemo() As String
Dim Path As String
Dim FindFirstFile As String
Path = "G:\BUYING\Food Specials\2. Planning\1. Planning\1. Planner\" & "8." & " " & Year(Date) & "\"
FindFirstFile = Dir$(Path & "*.xlsx")
While (FindFirstFile <> "")
If InStr(FindFirstFile, "Planner") > 0 Then
FindDepotMemo = Path & FindFirstFile
Exit Function
End If
FindFirstFile = Dir
Wend
End Function

Answer 1

Instead of having 2 For loops, just use the Application.Match to find matches between values in your 2 workbooks.
Use this code section below to replace with yours:
With wb2.Worksheets(1)
Dim MatchRow As Variant '<-- define variable to get the row number if Match is successful
lastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
'Lets begin our data merge
For i = 2 To lastRow
' If data meets criteria
' Check Planner For Turnover
' Use Application.Match to find matching results between workbooks
If Not IsError(Application.Match(ThisWorkbook.Worksheets("Data").Range("D" & i).Value, .Range("K2:K" & lastorw), 0)) Then ' check if Match is successful
MatchRow = Application.Match(ThisWorkbook.Worksheets("Data").Range("D" & i).Value, .Range("K2:K" & lastorw), 0) ' <-- get the row number where the match was found
ThisWorkbook.Worksheets("Data").Range("R" & j).Value = .Range("AG" & MatchRow).Value
End If
'Continue until all results found
Next i
End With

Answer 2

you could refactor your code as follows:
Option Explicit
Sub PlannerOpen()
Dim dataRng As Range, cell As Range
Dim depotMemo As String
Dim iRow As Variant
If FindDepotMemo(depotMemo) Then '<--| if successfully found the wanted file
With ThisWorkbook.Worksheets("Data1") '<--| reference your "Master" workbook relevant worksheet
Set dataRng = .Range("D2", .Cells(.Rows.Count, "D").End(xlUp)) '<--| set its item numbers range
End With
With Workbooks.Open(depotMemo, ReadOnly:=True, UpdateLinks:=False).Worksheets(1) '<--| open depotMemo workbook and reference its first worksheet
For Each cell In .Range("K2", .Cells(.Rows.Count, "K").End(xlUp)) '<--| loop through referenced worksheet column "K" cells from row 2 down to last not empty one
iRow = Application.Match(cell.Value, dataRng, 0) '<--| try finding current depotMemo item number in Master item numbers range
If Not IsError(iRow) Then dataRng(iRow, 1).Offset(, 14).Value = cell.Offset(, 22) '<--| if found then grab depotMemo current item amount and place it in corresponding "master" data sheet column R
Next
.Parent.Close False
End With
End If
End Sub
Function FindDepotMemo(depotMemo As String) As Boolean
Dim Path As String
Dim FindFirstFile As String
Path = "G:\BUYING\Food Specials\2. Planning\1. Planning\1. Planner\" & "8." & " " & Year(Date) & "\"
FindFirstFile = Dir$(Path & "*.xlsx")
While (FindFirstFile <> "")
If InStr(FindFirstFile, "Planner") > 0 Then
FindDepotMemo = True
depotMemo = Path & FindFirstFile
Exit Function
End If
FindFirstFile = Dir
Wend
End Function