VBA- Delete rows doesn't match with criteria

[J@rv!s]

I need VBA help. As you see in sheet1 there are some processing codes and Sheet2 which has data and in fourth column you can see processing codes I need to delete those rows where processing code from column 4 doesn't match with the processing code given in the sheet1 processing codes.

Sheet1
Processing Code
STD
DDT
BDI
RTI

And

Sheet2

Date Retion Sales Processing Code
01/01/15 West 91 DDT
01/01/15 West 30 BDI
11/04/15 South 23 BDI
09/01/15 East 51 LIN
01/14/15 East 45 DDT
04/04/15 West 47 RTI
06/27/15 West 40 TAN
12/23/15 East 70 STD
12/16/15 South 66 DDT
03/08/15 West 76 DON
12/11/15 East 58 BDI
01/10/15 South 96 STD
02/23/15 East 14 BON
09/27/15 West 85 BDI
06/25/15 East 40 STD
01/24/15 South 61 BDI
03/30/15 East 43 DDT
05/19/15 East 85 BDI
02/18/15 South 30 Jun
05/05/15 North 83 DDT
11/25/15 East 82 STD
05/26/15 East 18 STD
09/24/15 South 68 ALU
09/05/15 East 61 RTI
03/28/15 North 75 RTI
03/17/15 West 90 BDI
04/05/15 East 85 BDI
12/23/15 South 36 BDI
05/30/15 East 83 RTI
03/26/15 West 83 RTI
04/01/15 South 95 BDI
09/28/15 East 35 RTI
03/15/15 North 26 STD
10/15/15 South 70 STD
04/13/15 West 38 RTI
02/08/15 West 65 STD
01/08/15 West 98 DDT
09/03/15 East 69 BDI
05/08/15 South 31 DDT

 

[Deepak]

Check this..

Sub Remove_rows()
Dim c_rng As Range, rng As Range

Set c_rng = Sheet1.Range("A1").CurrentRegion
Set rng = Sheet2.Range("A1").CurrentRegion

rng.AdvancedFilter xlFilterCopy, c_rng, Sheet2.Range("ZZ1"), False
    rng.Cells.Clear
        Sheet2.Range("ZZ1").CurrentRegion.Cut Sheet2.Range("A1")

End Sub

 

[Villalobos]

another approach:

Sub DeleteRows()
Dim lastrow As Long, i As Long

Application.ScreenUpdating = False

With Sheets("Sheet2")
  lastrow = .Range("C" & Rows.Count).End(xlUp).Row
  For i = lastrow To 2 Step -1
  If IsError(Application.Match(.Range("C" & i).Value, Sheets("Sheet1").Range("A2:A5"), 0)) Then .Rows(i).Delete
  Next i
End With

Application.ScreenUpdating = True

End Sub

 

[ANKUSHRS1]

my approach are below

Sub delete_unwanted_records()

Worksheets("Sheet2").Activate

Dim c As Long
Dim i As Long

c = Application.WorksheetFunction.CountA(Worksheets("Sheet2").Range("a:a"))

For i = 2 To c

Worksheets("Sheet2").Range("g" & i).Value = "=VLOOKUP(d" & i & ",Sheet1!a:a,1,0)"


If IsError(Worksheets("Sheet2").Range("g" & i).Value) = True Then

Worksheets("Sheet2").Rows(i & ":" & i).Delete Shift:=xlUp

End If

Range("g" & i).Value = ""

Next

MsgBox "Processing Complete"


End Sub