vba copy corresponding values from another workbook?

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

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

Answer 2

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