VBA to delete rows based on cell value - vba

Question

I am trying to do the following :
VBA to lookup a value from a particular cell
Match these values in a particular column in specified sheets
Delete all rows from the sheet if the value do not match
I have tried the following - the code doesn't seem to function
Sub Delete()
Dim List As Variant
Dim LR As Long
Dim r As Long
List = Worksheets("Sheet1").Cells(28, "C").Value
LR = Range("E" & Rows.Count).End(xlUp).Row
For r = LR To 1 Step -1
If IsError(Application.Match(Range("E" & r).Value, List, False)) Then
Worksheets("Sheet2").Range("A1:AA36429").Rows(r).Delete
End If
Next r
End Sub

Answer 1

Try this:
Sub Delete()
Dim i As Integer
Dim LR As Long
Dim List As Variant
LR = Range("E" & Rows.Count).End(xlUp).Row
List = Worksheets("Sheet1").Cells(28, "C").Value
For i = 1 To LR
If Cells(i, "E").Value = List Then
Worksheets("Sheet1").Rows(i).Delete
End If
Next i
End Sub

Answer 2

I think you have a few ways of going about this, but the quickest way I know of is to use MATCH to compare values in a range to values in an array. Please note that this has a limit to 4000 or so values to compare before it fails. For your purposes, I think the following will work:
Sub test1()
Dim x As Long
Dim array1() As Variant
Dim array2() As Variant
array1 = Array("ABC", "XYX")
array2 = Range("A1:A2")
If IsNumeric(Application.Match(Range("A1").Value, array1, 0)) Then
x = 1
ElseIf IsNumeric(Application.Match(Range("A1").Value, array2, 0)) Then
x = IsNumeric(Application.Match(Range("A1").Value, array2, 0))
End If
'If x is not found in these arrays, x will be 0.
MsgBox x
End Sub
Another similar way is the following:
Sub test2()
Dim array1() As Variant
Dim FilterArray() As String
Dim x As Variant
x = Range("A1").Value
array1 = Array("ABC", "RANDOM", "VBA")
FilterArray = Filter(SourceArray:=array1, _
Match:=strText, _
Include:=True, _
Compare:=vbTextCompare)
If UBound(FindOutArray) = -1 Then
MsgBox "No, Array doesn't contain this item - " & x
Else
MsgBox "Yes, Array contains this item - " & x
End If
End Sub
So if we were to incorporate that all together (and I tested this btw):
Sub Delete()
Dim i As Integer
Dim LR As Long
Dim List() As Variant
Dim x As Long
LR = Range("E" & Rows.count).End(xlUp).Row
List = Worksheets("Sheet1").Range("A1:A2").Value
For i = 1 To LR
If IsNumeric(Application.Match(Cells(i, "E").Value, List, 0)) Then
Worksheets("Sheet1").Cells(i, "E").Value = ""
End If
Next i
Worksheets("Sheet1").Columns("E").SpecialCells(xlCellTypeBlanks).Cells.Delete
End Sub
This will set the cells that have values that are found in the array to blanks. Once the loop is finished, then the blank cells are deleted. If you want to shift the entire rows up, then use this as the last line instead:
Worksheets("Sheet1").Columns("E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete