Deleting Rows if certain criteria isnt met

[Big H]

Hopefully someone can help, the code below works fine for these two macros,
though there must be an easier way to achieve what I want.

What I want is to delete any rows if the criteria isnt met in column D. If
column D has either 1103 or 1203 or 1303 or 2103, then keep that column. if
it doesnt meet this criteria then delete the column.

The code below works, however I have to use the 2 macros to achieve it, any
help is appreciated.

Big H


Sub DeletePlants_ShowSpares()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

'ElseIf .Cells(Lrow, "D").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "***" in Column D,
case sensitive.
ElseIf .Cells(Lrow, "D").Value = "1101" Or _
.Cells(Lrow, "D").Value = "1102" Or _
.Cells(Lrow, "D").Value = "1201" Or _
.Cells(Lrow, "D").Value = "1202" Or _
.Cells(Lrow, "D").Value = "1302" Or _
.Cells(Lrow, "D").Value = "2102" Or _
.Cells(Lrow, "D").Value = "3101" Or _
.Cells(Lrow, "D").Value = "3102" Or _
.Cells(Lrow, "D").Value = "CASE" Or _
.Cells(Lrow, "D").Value = "HPMC" Or _
.Cells(Lrow, "D").Value = "OBCA" Or _
.Cells(Lrow, "D").Value = "OBDD" Or _
.Cells(Lrow, "D").Value = "OBRD" Or _
.Cells(Lrow, "D").Value = "TRBD" Or _
.Cells(Lrow, "D").Value = "CBCC" Or _
.Cells(Lrow, "D").Value = "CBSD" Or _
.Cells(Lrow, "D").Value = "CBSL" Or _
.Cells(Lrow, "D").Value = "COSL" Or _
.Cells(Lrow, "D").Value = "CPSD" Or _
.Cells(Lrow, "D").Value = "CPSL" Or _
.Cells(Lrow, "D").Value = "CTSL" Or _
.Cells(Lrow, "D").Value = "CV01" Or _
.Cells(Lrow, "D").Value = "CV05" Or _
.Cells(Lrow, "D").Value = "DISC" Or _
.Cells(Lrow, "D").Value = "DSFT" Then .Rows(Lrow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

Sub DeletePlants_ShowSpares1()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
LastRow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1

With ActiveSheet
.DisplayPageBreaks = False
For Lrow = LastRow To Firstrow Step -1

If IsError(.Cells(Lrow, "D").Value) Then
'Do nothing, This avoid a error if there is a error in the
cell

'ElseIf .Cells(Lrow, "D").Value = "CSVS" Then .Rows(Lrow).Delete
'This will delete each row with the Value "***" in Column D,
case sensitive.
ElseIf .Cells(Lrow, "D").Value = "ENUL" Or _
.Cells(Lrow, "D").Value = "FNSD" Or _
.Cells(Lrow, "D").Value = "FNSL" Or _
.Cells(Lrow, "D").Value = "HCAS" Or _
.Cells(Lrow, "D").Value = "6103" Or _
.Cells(Lrow, "D").Value = "61MP" Or _
.Cells(Lrow, "D").Value = "CTSD" Or _
.Cells(Lrow, "D").Value = "DB01" Or _
.Cells(Lrow, "D").Value = "HSMW" Or _
.Cells(Lrow, "D").Value = "ISLS" Or _
.Cells(Lrow, "D").Value = "ISTR" Or _
.Cells(Lrow, "D").Value = "LAF" Or _
.Cells(Lrow, "D").Value = "PW03" Or _
.Cells(Lrow, "D").Value = "PW05" Or _
.Cells(Lrow, "D").Value = "PW07" Or _
.Cells(Lrow, "D").Value = "RNGS" Or _
.Cells(Lrow, "D").Value = "SCAM" Or _
.Cells(Lrow, "D").Value = "SDUL" Or _
.Cells(Lrow, "D").Value = "SHFT" Or _
.Cells(Lrow, "D").Value = "SUND" Or _
.Cells(Lrow, "D").Value = "TNSD" Or _
.Cells(Lrow, "D").Value = "TNSL" Or _
.Cells(Lrow, "D").Value = "FAST" Or _
.Cells(Lrow, "D").Value = "TSPR" Or _
.Cells(Lrow, "D").Value = "WCFB" Then .Rows(Lrow).Delete
End If
Next
End With

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

 

[Guest]

Using a little bit of Algebra we get


ElseIf (.Cells(Lrow, "D").Value <> "1103") And _
(.Cells(Lrow, "D").Value <> "1203") And _
(.Cells(Lrow, "D").Value <> "1303") And _
(.Cells(Lrow, "D").Value <> "2103") Then .Rows(Lrow).Delete
End If