Sub Suppression()
Dim L%, A%, B%
Application.ScreenUpdating = False
DerLig = Range("A65500").End(xlUp).Row
For L = DerLig To 1 Step -1
A = Application.CountIf(Range(L & ":" & L), "Rich")
B = Application.CountIf(Range(L & ":" & L), "Precious Alloy")
If A > 0 And B = 0 Then Rows(L).Delete
Next L
End Sub
Sub test()
Dim p As Range
With ActiveSheet.Range("F1:G1").Resize(ActiveSheet.UsedRange.Count)
.AutoFilter Field:=2, Criteria1:="Rich"
.AutoFilter Field:=1, Criteria1:="<>*Alloy*"
Set p = .SpecialCells(xlVisible)
.AutoFilter
End With
p.EntireRow.Delete shift:=xlUp
End Sub