Get the respective values of the latest closing date - excel

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)

Answer 3

SORT And XLOOKUP to Get Maximums
In Microsoft 365, you could use the following spilling formula in cell K3 of Sheet1:
=LET(sArray,Sheet2!A3:M22,sFilterCol,13,sCriteria,"Closed",sSortCols,{11;1},sSortOrders,{-1;1},sLookupCol,1,sReturnCol,2,
dLookup,A3:A14,dNotFound,"NA",
sSorted,SORT(FILTER(sArray,CHOOSECOLS(sArray,sFilterCol)=sCriteria),sSortCols,sSortOrders),
sLookup,CHOOSECOLS(sSorted,sLookupCol),sReturn,CHOOSECOLS(sSorted,sReturnCol),
XLOOKUP(dLookup,sLookup,sReturn,dNotFound))
The 1st row holds the source constants (7) while the 2nd row the destination constants (2).
The 3rd row returns the source array filtered and sorted.
In the 4th row this modified array is used to get the source lookup and return columns.
These columns, along with the destination constants, are then fed to the XLOOKUP function in the 5th row.
Edit
For this to work with your test files, with Book2.xlsx open, you need to replace Sheet2!A3:M22 with '[Book2.xlsx]Wb2-sh1'!A3:M18, A3:A14 with A3:A8 and Closed with Close (my bad).