VBA. Replace a table cell content based on match from another table or delete entire row if match is not found - vba

Question

I am trying to make the following to work:
There are two tables in a separate worksheets. I want it to check each cell in worksheet2 column B and find a match from worksheet1 column A. If a match is found then replace the data in worksheet2 column B with a data from a matching row of worksheet1 column B.
If a match is not found from a worksheet1 column A then delete entire row in a worksheet2 column B.
Sub match_repl_del()
Dim r1 As Long, rfound, vfound
Dim w1, w2, v As Long
Set w1 = Sheets(3) ' data sheet
Set w2 = Sheets(2) ' target sheet
r1 = 2 'data starting from row 2
Do While Not IsEmpty(w1.Cells(r1, 1))
v = w1.Cells(r1, 1)
rfound = Application.Match(v, w2.Columns(2), 0) ' look for value
If Not IsError(rfound) Then ' found it?
vfound = w2.Cells(rfound, 2)
If w1.Cells(r1, 2) <> vfound Then ' if value does not match sheet1 column b
w2.Cells(rfound, 2) = w1.Cells(r1, 2) ' update based on origin sheet
lastC = w2.Cells(rfound, 1).End(xlToRight).Column
w2.Range(w2.Cells(rfound, 1), w2.Cells(rfound, lastC)).Interior.ColorIndex = 5
Else ' delete entire row on sheet2 if match is not found
w2.Rows(r1).EntireRow.Delete
End If
End If
r1 = r1 + 1
Loop
End Sub

Answer 1

Try this wat, it's work for me :
Option Explicit
Sub test()
' Active workbook
Dim wb As Workbook
Set wb = ThisWorkbook
Dim i As Long
Dim j As Long
'*******************************************
'Adapt this vars
'define your sheets
Dim ws_1 As Worksheet
Dim ws_2 As Worksheet
Set ws_1 = wb.Sheets("Sheet1") 'find a match in worksheet1 column A
Set ws_2 = wb.Sheets("sheet2") 'cell in worksheet2 column B
'definie the last Rows
Dim lastRow_ws1 As Long
Dim lastRow_ws2 As Long
lastRow_ws1 = ws_1.Range("A" & Rows.Count).End(xlUp).Row 'if you need, adjust column to find last row
lastRow_ws2 = ws_2.Range("B" & Rows.Count).End(xlUp).Row 'if you need, adjust column to find last row
'*******************************************
For i = lastRow_ws2 To 2 Step -1
For j = 1 To lastRow_ws1
Dim keySearch As String
Dim keyFind As String
keySearch = ws_2.Cells(i, 2).Value
keyFind = ws_1.Cells(j, 1).Value
If keySearch = keyFind Then
'MsgBox keySearch & " " & keyFind & " yes"
ws_2.Cells(i, 2).Value = ws_1.Cells(j, 2).Value
GoTo next_i
End If
Next j
ws_2.Rows(i).EntireRow.Delete
next_i:
Next i
End Sub