Compare and copy data between worksheets where there is a one to many match Excel 365

[Memmags]

I have a master file which list each Vendor(col B) and their related code (col C). I need to update a transaction list which many rows that may include the vendor more than once to add this code from master list. The code as is finds the vendor once, updates the code then moves to next vendor. I need it update all rows with same code.

Sub matchList()
Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long
Application.ScreenUpdating = False

Set w1 = Worksheets("Master Vendor List")
Set w2 = Worksheets("Vendor Data")

For Each c In w1.Range("B2", w1.Range("B" & Rows.Count).End(xlUp))
FR = 0
On Error Resume Next
FR = Application.Match(c, w2.Columns(15), 0)
On Error GoTo 0
If FR <> 0 Then w2.Range("AH" & FR).Value = c.Offset(, 1)
Next c
Application.ScreenUpdating = True
End Sub

 

[Memmags]

I was able to find a different script that solved this problem

Sub matchList()

Dim sh As Worksheet, sh2 As Worksheet, lr As Long, rng As Range, fItem As Range

Set sh = Worksheets("Master Vendor List")
Set sh2 = Worksheets("VendorData")

lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
For Each c In rng
With sh2
Set fItem = .Range("O:O").Find(c.Value, LookIn:=xlValues)
If Not fItem Is Nothing Then
fAddr = fItem.Address
Do
If fItem.Offset(0, 1) = "" Then
fItem.Offset(0, 19) = c.Offset(0, 1).Value
End If
fItem.Value = c.Value
Set fItem = .Range("O:O").FindNext(fItem)
Loop While fItem.Address <> fAddr
End If
End With
Next
End Sub

 

[Memmags]

I have one problem with the new code. I have a vendor that is Capitalize and a second Vendor Capitalized Interest with different codes. The code updates my Vendor Capitalized Interest to Capitalize and then provides code for Capitalize which is first in the list.