Macro to Delete Rows based on Specific Conditions

Try this :

Sub test()
lastrow = Range("A65536").End(xlUp).Row
For i = lastrow To 1 Step -1
If Cells(i, 1).Value <> Range("A1").Value And Cells(i, 1).Value <> Range("A2").Value And Cells(i, 1).Value <> Range("A3").Value Then Cells(i, 1).EntireRow.Delete
Next
End Sub

Please click the * below if this helps

I didn't think you'd have less than 3 unique slopes.

Try amended code below :

Sub test()
lr = Range("A65536").End(xlUp).Row
x = 2
a = Range("A1").Value
b = ""
c = ""

Do Until b <> "" Or x = lr
If Range("A" & x).Value <> a Then b = Range("A" & x).Value
x = x + 1
Loop

If x = lr Then GoTo nxt

Do Until c <> "" Or x = lr
If Range("A" & x).Value <> a And Range("A" & x).Value <> b Then c = Range("A" & x).Value
x = x + 1
Loop

nxt:
If b = "" Then GoTo just1
If c = "" Then GoTo just2

For i = lr To 1 Step -1
If Cells(i, 1).Value <> a And Cells(i, 1).Value <> b And Cells(i, 1).Value <> c Then Cells(i, 1).EntireRow.Delete
Next
Exit Sub

just1:
For i = lr To 1 Step -1
If Cells(i, 1).Value <> a Then Cells(i, 1).EntireRow.Delete
Next
Exit Sub

just2:
For i = lr To 1 Step -1
If Cells(i, 1).Value <> a And Cells(i, 1).Value <> b Then Cells(i, 1).EntireRow.Delete
Next
End Sub

Please click the * below if this helps

Since you specifically mention three slopes, I adjusted the code I gave you in the first place. If you want it to work for 1 or 2 slopes, just adjust the other code yourself (is good exercise for you )

Sub test()
x = 2
a = Range("A1").Value

Do Until b <> ""
If Range("A" & x).Value <> a Then b = Range("A" & x).Value
x = x + 1
Loop
Do Until c <> ""
If Range("A" & x).Value <> a And Range("A" & x).Value <> b Then c = Range("A" & x).Value
x = x + 1
Loop

lastrow = Range("A65536").End(xlUp).Row
k = 0
l = 0
m = 0

For i = 1 To lr 
If Cells(i, 1).Value <> a And Cells(i, 1).Value <> b And Cells(i, 1).Value <> c Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = a Then
k = k + 1
If k > 1 then Cells(i, 1).EntireRow.Delete
End if
If Cells(i, 1).Value = b Then
l = l + 1
If l > 1 then Cells(i, 1).EntireRow.Delete
End if

If Cells(i, 1).Value = c Then
m = m + 1
If m > 1 then Cells(i, 1).EntireRow.Delete
End if

Next
End Sub

Again, if this helps you, please click the * below