Delete row if "cell.Value" equals a cell in a range

[tonye104292]

Hi all, long time reader, first time poster.

I have the code below (not mine but it runs/works fine) that basically deletes a row in a sheet if a cell in that row equals a specific value (in this case, if it equals Total World, Europe, North, or South).

Im wondering if there is a way to modify the code below so if cell.Value equals a cell in a range in a worksheet, then it deletes that row. This would be instead of me specifying in the code "cell.Value = abc OR cell.Value = def" in order to save time and not specify in the code the hundreds of values that I want to add.

Essentially, I want to post the values in the quotes below "Total World, Europe, North, South" in a range in a worksheet, rather than in the code. Highlighted in red is what I want to modify.

Sub DeleteTotalClusterRows()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("H:H"), ActiveSheet.UsedRange)
For Each cell In rng
[COLOR=#ff0000]If (cell.Value) = "Total World" Or (cell.Value) = "Europe," Or (cell.Value) = "North" Or (cell.Value) = "South" _[/COLOR]
Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

 

[pplstuff]

Sub DeleteTotalClusterRows()
Dim rng As Range, cell As Range, del As Range
dim sCriteria as string
Set rng = Intersect(Range("H:H"), ActiveSheet.UsedRange)
scriteria = range("A1")
For Each cell In rng
If (cell.Value) = scriteria Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete

Change range ("A1") to the cell your criteria will be in.
End Sub

 

[tonye104292]

Sub DeleteTotalClusterRows()
Dim rng As Range, cell As Range, del As Range
dim sCriteria as string
Set rng = Intersect(Range("H:H"), ActiveSheet.UsedRange)
scriteria = range("A1")
For Each cell In rng
If (cell.Value) = scriteria Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete

Change range ("A1") to the cell your criteria will be in.
End Sub

But I wont just be checking each cell against 1 value, it'll be more like a few thousand values which is why I want it to lookup the values in a table, or range, not just 1 cell.

 

[pplstuff]

Sub DeleteTotalClusterRows()
Dim rng As Range, cell As Range, del As Range
dim sCriteria as string
dim i as long
Set rng = Intersect(Range("H:H"), ActiveSheet.UsedRange)
for i = 1 to 10
scriteria = cells(i, 1)
For Each cell In rng
If (cell.Value) = scriteria Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
next i
end sub

This will now loop from A1:A10 and delete from your range if any the column H value = anything in A1:A10

Adjust as needed.

 

[kevatarvind]

hi try below code Put your criteria in Sheet2 Column A or you can change the range ( Highlighted) to where your criteria listed

Option Explicit
Sub DeleteTotalClusterRows()
Dim rng As Range, cell As Range, del As Range, lkrng As Range
Set rng = Intersect(Range("H:H"), ActiveSheet.UsedRange)
Set lkrng = Sheets("Sheet2").Range("A:A")
For Each cell In rng
   On Error Resume Next
   If WorksheetFunction.Match(cell.Value, lkrng, False) > 0 Then
      If Err.Number = 1004 Then
        GoTo Nextt
      Else
        If del Is Nothing Then
          Set del = cell
          Else: Set del = Union(del, cell)
        End If
      End If
   End If
Nextt:
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

 

[rollis13]

Cross-post: Delete row if "cell.Value" equals a cell in a range