Get the respective values of the latest closing date

Question

As you see on the above picture:
I need to match the values on Wb1.coumns(1) with the other workbook Wb2.coumns(1) with some conditions.
Wb2 will be filtered of the value Close at column M.
Then I seek the latest closing date and get it’s respective value at column B and input that value in Wb1.column(K).
the below code may work on the provided example correctly, But it is not reliable on my actual dataset, because it depends on the sort of many columns from oldest to newest.
This is a link for the provided sample

  Sub Get_the_respective_value_of_Last_Closing_Date()
     
       Dim wb1 As Workbook, wb2 As Workbook
       Dim ws1 As Worksheet, ws2 As Worksheet
       Dim rng1 As Range, rng2 As Range
       Dim arr1() As Variant, arr2() As Variant
     
       Application.ScreenUpdating = False
     
       Set wb1 = ThisWorkbook
       Set wb2 = Workbooks.Open("Path of wb2", UpdateLinks:=False, ReadOnly:=True)
     
        Set ws1 = wb1.Sheets(1)
        Set ws2 = wb2.Sheets(1)
     
         Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)   'Main Range
         Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)
     
          arr1 = rng1.Value2
          arr2 = rng2.Value2
     
       Dim i As Long, k As Long
        For i = LBound(arr1) To UBound(arr1)
         For k = LBound(arr2) To UBound(arr2)
     
          If arr1(i, 1) = arr2(k, 1) And arr2(k, 13) = "Close" Then
             rng1.Cells(i, 11) = arr2(k, 2)
          End If
     
          Next k
        Next i
     
       wb2.Close SaveChanges:=False
       Application.ScreenUpdating = True
    End Sub

Answer 1

Please, try the next adapted code. It uses a dictionary, to keep the unique kay (and last value from "K:K" as item) of the opened Workbook, then placing the appropriate data in the working workbook:

Sub Get_Last_Closing_Date()

   Dim wb1 As Workbook, wb2 As Workbook
   Dim ws1 As Worksheet, ws2 As Worksheet
   Dim rng1 As Range, rng2 As Range
   Dim arr1() As Variant, arr2() As Variant
   Dim dict As Object
   
   Application.ScreenUpdating = False

   Set wb1 = ThisWorkbook
   'Please, update the real path of "Book2.xlsx":
   Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)
   
    Set ws1 = wb1.Sheets(1)
    Set ws2 = wb2.Sheets(1)
   
     Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)   'Main Range
     Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

      arr1 = rng1.Value2
      arr2 = rng2.Value2

     'place the unique last key in a dictionary:
     Dim i As Long
     Set dict = CreateObject("Scripting.dictionary")
     For i = 1 To UBound(arr2)
        If arr2(i, 13) = "Close" Then
             dict(arr2(i, 1)) = arr2(i, 2)
        End If
    Next i
    Debug.Print Join(dict.items, "|") 'just to visualy see the result
    
    'Place the necessary data in its place:
    For i = 1 To UBound(arr1)
        If dict.Exists(arr1(i, 1)) Then
            arr1(i, 11) = dict(arr1(i, 1))
        Else
            arr1(i, 11) = "NA"
        End If
    Next i
    
    rng1.Value2 = arr1 'drop back the updated array content
    
   wb2.Close SaveChanges:=False
   
   Application.ScreenUpdating = True
   MsgBox "Ready..."
End Sub

Column "K:K" of the workbook to be opened must be sorted ascending...

Edited:

The next version works without needing to have column "K:K" sorted:

Sub Get_Last_Closing_Date()
   Dim wb1 As Workbook, wb2 As Workbook
   Dim ws1 As Worksheet, ws2 As Worksheet
   Dim rng1 As Range, rng2 As Range
   Dim arr1() As Variant, arr2() As Variant
   Dim dict As Object
   
   Application.ScreenUpdating = False

   Set wb1 = ThisWorkbook
   Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)
   
    Set ws1 = wb1.Sheets(1)
    Set ws2 = wb2.Sheets(1)
   
     Set rng1 = ws1.Range("A3:K" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)   'Main Range
     Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

      arr1 = rng1.Value2
      arr2 = rng2.Value2

     'place the unique last key in a dictionary:
     Dim i As Long
     Set dict = CreateObject("Scripting.dictionary")
     For i = 1 To UBound(arr2)
        If arr2(i, 13) = "Close" Then
            If Not dict.Exists(arr2(i, 1)) Then
                dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11)) 'place the date from K:K, too
            Else
                If CDate(arr2(i, 11)) > CDate(dict(arr2(i, 1))(1)) Then 'change the item only in case of a more recent date:
                    dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11))
                End If
            End If
        End If
    Next i

    'Place the necessary data in its place:
    For i = 1 To UBound(arr1)
        If dict.Exists(arr1(i, 1)) Then
            arr1(i, 11) = dict(arr1(i, 1))(0) 'extract first item array element
        Else
            arr1(i, 11) = "NA"
        End If
    Next i
    
    rng1.Value2 = arr1 'drop back the updated array content
    
   wb2.Close SaveChanges:=False
   
   Application.ScreenUpdating = True
   MsgBox "Ready..."
End Sub

Answer 2

You may benefit from functions in Excel and combine them with Evaluate trough VBA. Just as example I made up this:

I made up this in same worksheet just as explanation. The formula to get this in column K is:

=IFERROR(INDEX($N$2:$N$16,SUMPRODUCT(--($W$2:$W$16=MAX(--($Y$2:$Y$16="Close")*--($M$2:$M$16=A2)*$W$2:$W$16))*ROW($M$2:$M$16))-1),"NA")

This formula will return desired output. Applied to VBA would be:

Sub Get_Last_Closing_Date()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng2 As Range
Dim i As Long
Dim MyFormula As String

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open("D:\Users\gaballahw\Desktop\Book2.xlsx", UpdateLinks:=False, ReadOnly:=True)

Set ws1 = wb1.Sheets(1)
Set ws2 = wb2.Sheets(1)

Set rng2 = ws2.Range("A3:M" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)

With ws1
    For i = 3 To ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row Step 1
        MyFormula = "IFERROR(INDEX(" & rng2.Columns(2).Address & ",SUMPRODUCT(--(" & rng2.Columns(11).Address & _
            "=MAX(--(" & rng2.Columns(13).Address & "=""Close"")*--(" & rng2.Columns(1).Address & _
            "=" & .Range("A" & i).Value & ")*" & rng2.Columns(11).Address & "))*ROW(" & rng2.Columns(1).Address & "))-2),""NA"")" '-2 because data starts at row 3
        .Range("K" & i).Value = Evaluate(MyFormula)
    Next i
End With
 
wb2.Close SaveChanges:=False

Set rng2 = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
Set wb1 = Nothing
Set wb2 = Nothing

Application.ScreenUpdating = True
End Sub

Also, if you have Excel365 you may benefit from function MAXIFS:

MAXIFS function

I'm pretty sure that in the formula provided the part --($W$2:$W$16=MAX(--($Y$2:$Y$16="Close")*--($M$2:$M$16=A2)*$W$2:$W$16)) could be replaced with a MAXIFS but i got an older version of Excel so I can't test.

Also, check Evaluate:

Application.Evaluate method (Excel)