I need to match the data from the workbook wb1.coumns(1) with the other workbook wb2.coumns(1) under specific circumstances as described in this inquiry Link.
The value Close will be filtered out of Wb2 at column 13 M.
To find the most recent closing date for the open worksheet Wb2, locate column 11 K, copy the corresponding values from columns B and Q:X (on the same row), and then paste these values into the corresponding Wb1 columns S:AA.
The code below is intended to return the values from just one column of wb2 (column "B")

This is the Link for the test workbooks.

```Option Explicit
Option Compare Text

Sub Get_Respective_Values_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
Dim dict As New Dictionary

Application.ScreenUpdating = False

Set wb1 = ThisWorkbook

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

Set rng1 = ws1.Range("A3:AA" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)  'Main Range
Set rng2 = ws2.Range("A3:X" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)   'Opened Workbook_Range

arr1 = rng1.Value2
arr2 = rng2.Value2

'place the unique last key in a dictionary:
Dim i As Long
For i = 1 To UBound(arr2)
If arr2(i, 13) = "Close" Then   'Column (Status)
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, 19) = dict(arr1(i, 1))(0) 'extract first item array element
Else
arr1(i, 19) = "NA"
End If
Next i

rng1.Value2 = arr1 'drop back the updated array content

ws1.Activate

'   wb2.Close SaveChanges:=False

Application.ScreenUpdating = True

End Sub
```
Feb 6 in Others 53 views

## 1 answer to this question.

Try this:

```Sub Get_Respective_Values_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
Dim dict As New Dictionary

'Application.ScreenUpdating = False

Set wb1 = ThisWorkbook

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

Set rng1 = ws1.Range("A3:AA" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row)  'Main Range
Set rng2 = ws2.Range("A3:X" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)    'Opened Workbook_Range

arr1 = rng1.Value2
arr2 = rng2.Value2

'place the unique last key in a dictionary:
Dim i As Long, arrAtt, j As Long, k As Long
ReDim arrAtt(7) 'the 1D array should contain maximum number of elements from "Q" to "X"
'meaning 8 columns. since arrAtt is 1D zero based, it may keep 8 elements
For i = 1 To UBound(arr2)
If arr2(i, 13) = "Close" Then           'Column (Status)
Erase arrAtt: ReDim arrAtt(7)       'erase the previous loaded array, if the case (to be loaded...)
If Not dict.Exists(arr2(i, 1)) Then
For j = 0 To UBound(arrAtt)     'iterate between the 8 array elements
If arr2(i, 17 + j) <> "" Then
arrAtt(k) = arr2(i, 17 + k): k = k + 1 'add the found URLs and increment k
Else
Exit For                               'exit the iteration if no URL exists
End If
Next j
If k > 0 Then ReDim Preserve arrAtt(k - 1)     'keep only the loaded elements
dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11), arrAtt)   'Place attachments array, too
k = 0 'reinitialize k variable
Else
If CDate(arr2(i, 11)) > CDate(dict(arr2(i, 1))(1)) Then 'Change the item only in case of a more recent  Date
Erase arrAtt: ReDim arrAtt(7) 'erase the previous loaded array
For j = 0 To UBound(arrAtt)
If arr2(i, 17 + j) <> "" Then
arrAtt(k) = arr2(i, 17 + k): k = k + 1
Else
Exit For
End If
Next j
If k > 0 Then ReDim Preserve arrAtt(k - 1)
dict(arr2(i, 1)) = Array(arr2(i, 2), arr2(i, 11), arrAtt)     'Place attachments array, too
k = 0
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, 19) = dict(arr1(i, 1))(0) 'extract first item array element
For j = 0 To UBound(dict(arr1(i, 1))(2))          'extract existing URLs
If dict(arr1(i, 1))(2)(j) = "" Then Exit For  'exit the loop in case of empty strings
arr1(i, 20 + j) = dict(arr1(i, 1))(2)(j)      'place the URLs in their position
Next j
Else
arr1(i, 19) = "NA"
End If
Next i

rng1.Value2 = arr1 'drop back the updated array content

ws1.Activate

'   wb2.Close SaveChanges:=False

Application.ScreenUpdating = True

End Sub```
• 59,740 points

## Prevent a user from adding or removing row(s) of a Range, but allow him to do so on another Range on the same sheet

The only thing I can offer is ...READ MORE

## Finding the minimum values from different columns according to the criteria and multiplying by another column

We must use SUBTOTAL and OFFSET in ...READ MORE

## Excel formula for searching two text in one cell and return values based on the result

You can include a second IF within ...READ MORE

## How can I copy from specific sheet in excel

You should use wb.Sheets("Name of sheet").Copy - ...READ MORE

## VBA How do I replace the range with an array in SUMIF

You can't, in my opinion. When you ...READ MORE

## Excel VBA compare values on multiple rows and execute additional code

I would use a Dictionary & Collection ...READ MORE

## How to concatenate elements of a single-dimensional array using VBA?

Using Microsoft 365's UNIQUE and SORT in VBA ' This is a ...READ MORE

## Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE