VBA pull through value from other workbook where values are a match?

Question

I am using the following vba code to copy values from column G in work book B and paste them into workbook A - where values match.

Workbook B contains the following:

Column C            Column D        Column E      Column G
21/12/2016          123             444           100
12/12/2016          111             555           100
11/11/2014          123             444           0

Workbook A

Column D            Column G        Column J      Column AX
21/12/2016          123             444
12/12/2016          111             555
11/11/2014          123             444 

Essentially the value from workbook B, column G corresponding to each matching value needs to end up in column AX on workbook A.

The dates represent delivery dates. The values in column G are quantities delivered.

The code works most of the time, except sometimes i have more than one occurrence of each item number in column D/J.

Sometimes i am getting the wrong results. i.e. where the item number in row 1 is 444 and then occurs again in row 3. the code will check the wrong delivery date or the wrong quantities delivered for these item numbers.

This is because my code does not ensure the values all match in the same line. I need it to do this.

Option Explicit
Option Compare Text

Sub Expecting()

ActiveSheet.EnableCalculation = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim app As New Excel.Application
app.Visible = False 'Visible is False by default, so this isn't necessary


    Dim oCell As Range, oCell2 As Range, oCell3 As Range, oCell4 As Range, targetCell As Range
    Dim ws2 As Worksheet
    Dim lastRow As Long


       If IsFileOpen("\\gb-ss04\001_DATA\WH DISPO\(5) WH SHARED DRIVE\(21) WAREHOUSE RECEIVINGS\Order Checker.xlsm") Then

        Else

        Workbooks.Open "\\gb-ss04\001_DATA\WH DISPO\(5) WH SHARED DRIVE\(21) WAREHOUSE RECEIVINGS\Order Checker.xlsm"
        End If

        If Not GetWb("Order Checker", ws2) Then Exit Sub

        lastRow = Range("J" & Rows.Count).End(xlUp).Row

        With ws2
            For Each targetCell In Range("J6:J" & lastRow)
                Set oCell = .Range("D1", .Cells(.Rows.Count, "D").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole)
                Set oCell2 = .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)).Find(what:=targetCell.Offset(0, -3).Value, LookIn:=xlValues, lookat:=xlWhole)
                Set oCell3 = .Range("E1", .Cells(.Rows.Count, "E").End(xlUp)).Find(what:=CStr(targetCell.Offset(0, -6)), LookIn:=xlValues, lookat:=xlWhole)


                If Not oCell Is Nothing And Not oCell2 Is Nothing And Not oCell3 Is Nothing Then


                    Application.EnableEvents = False

                    If oCell.Offset(0, 3) <> "0 / 0" Then
                    targetCell.Offset(0, 12).Value = oCell.Offset(0, 3)
                    Else
                    targetCell.Offset(0, 12).Value = "0"
                    End If


                    Application.EnableEvents = True

                End If



            Next
        End With






Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True



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(2)
            Exit For
        End If
    Next
    GetWb = Not ws Is Nothing
End Function

Please can someone show me where i am going wrong?

Answer 1

Your code is erroneous because of unqualified ranges. consider what happens when you open the checker workbook: it becomes the Active workbook and all unqualified ranges will go to it! When when you do this:

For Each targetCell In Range("J6:J" & lastRow) ' <~~ refers to ActiveWorkbook!

With ws2
   Set oCell = .Range("D1", .Cells(.Rows.Count, "D").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole)

in the find above, you are comparing the recently opened workbook to itself. It did not happen before as you say, yes, because before, the WB was already open so you did not open it again, so it did not steel the ActiveWorkbook property! As I told you in a previous comment, random behavior is typical when you use unqualified ranges, because they refer to the Active things (wb, ws).

The other error was that you were not ensuring that the matched values are on the same row. The following will do, though might need some customization to your files' structure (position of the worksheets and ranges)

Option Explicit
Sub Expecting()
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim wbChecker As Workbook
    On Error Resume Next
    Set wbChecker = Workbooks("Order Checker.xlsm")
    If wbChecker Is Nothing Then Set wbChecker = Workbooks.Open("\\gb-ss04\001_DATA\WH DISPO\(5) WH SHARED DRIVE\(21) WAREHOUSE RECEIVINGS\Order Checker.xlsm")
    If wbChecker Is Nothing Then Exit Sub

    On Error GoTo cleanup
    Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets(1)
    Dim ws2 As Worksheet: Set ws2 = wbChecker.Worksheets(1)
    Dim lastRow1 As Long, lastRow2 As Long, ro1 As Long, ro2 As Long

    lastRow1 = ws1.Range("J" & ws1.Rows.Count).End(xlUp).Row
    lastRow2 = ws2.Range("D" & ws2.Rows.Count).End(xlUp).Row

    For ro2 = 1 To lastRow2
        For ro1 = 6 To lastRow1
            If ws1.Cells(ro1, "D").Value = ws2.Cells(ro2, "C").Value And _
               ws1.Cells(ro1, "G").Value = ws2.Cells(ro2, "D").Value And _
               ws1.Cells(ro1, "J").Value = ws2.Cells(ro2, "E").Value Then _
               ws1.Cells(ro1, "AX").Value = IIf(ws2.Cells(ro2, "G").Value <> "0 / 0", ws2.Cells(ro2, "G").Value, "0")
        Next
    Next

cleanup:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub