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

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

Okay? What's your question? Does your code not work? Does it give an error? Can you please clarify what your question/issue is? — BruceWayne
I got the first part of it working. It replaced the content of the cells as needed, but I failed to get the .EntireRow.Delete working. Probably this is not a right way to make it work... — Kris

JC Guidicelli JC Guidicelli · Accepted Answer · 2018-06-18T14:22:47

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

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

1 Answers