i have 2 workbooks, workbook A and workbook B. Each workbook has a table. workbook A has 2 columns. All three columns are filled.
try this
Sub UpdateW2()
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim w1 As Worksheet, w2 As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set w1 = Workbooks("workbookA.xlsm").Sheets("Sheet1")
Set w2 = Workbooks("workbookB.xlsm").Sheets("Sheet1")
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w1.Range("D2:D" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, -3).Value
End If
Next
i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w2.Range("A2:A" & i)
For Each key In Dic
If oCell.Value = key Then
oCell.Offset(, 2).Value = Dic(key)
End If
Next
Next
End Sub
use this
Sub UpdateW2()
Dim key As Variant, oCell As Range, i&, z%
Dim w1 As Worksheet, w2 As Worksheet
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dim Dic2 As Object: Set Dic2 = CreateObject("Scripting.Dictionary")
Set w1 = Workbooks("workbookA.xlsm").Sheets("Sheet1")
Set w2 = Workbooks("workbookB.xlsm").Sheets("Sheet1")
'-------------------------------------------------------------------------
'get the last row for w1
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
'-------------------------------------------------------------------------
' fill dictionary with data for searching
For Each oCell In w1.Range("D2:D" & i)
'row number for duplicates
z = 1: While Dic.exists(oCell.Value & "_" & z): z = z + 1: Wend
'add data with row number to dictionary
If Not Dic.exists(oCell.Value & "_" & z) Then
Dic.Add oCell.Value & "_" & z, oCell.Offset(, -3).Value
End If
Next
'-------------------------------------------------------------------------
'get the last row for w2
i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
'-------------------------------------------------------------------------
'fill "B" with results
For Each oCell In w2.Range("A2:A" & i)
'determinate row number for duplicated values
z = 1: While Dic2.exists(oCell.Value & "_" & z): z = z + 1: Wend
'search
For Each key In Dic
If oCell.Value & "_" & z = key Then
oCell.Offset(, 2).Value = Dic(key)
End If
Next
'correction of the dictionary in case
'when sheet "A" has less duplicates than sheet "B"
If oCell.Offset(, 2).Value = "" Then
Dic2.RemoveAll: z = 1
For Each key In Dic
If oCell.Value & "_" & z = key Then
oCell.Offset(, 2).Value = Dic(key)
End If
Next
End If
'add to dictionary already passed results for
'the next duplicates testing
If Not Dic2.exists(oCell.Value & "_" & z) Then
Dic2.Add oCell.Value & "_" & z, ""
End If
Next
End Sub
output results below