如果单元格值不在列表中，则删除行

Question

I have 2 sheets : in the first i have date and in sheet2 i have a list of names in column A . I want to delete all the rows that don't have the names from sheet2 in the column O from the first sheet. The code just deletes everything from the first sheet. Any help is welcomed.

Sub Demo()
Dim Rng As Range, List As Object, Rw As Long
Dim x As Date
x = Now()

Set List = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
  For Each Rng In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
    If Not List.Exists(Rng.Value) Then
      List.Add Rng.Value, Nothing
    End If
  Next
End With

With Sheets("query " & Format(x, "dd.mm.yyyy"))
  For Rw = .Range("O" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Not List.Exists(.Cells(Rw, "O").Value) Then
      .Rows(Rw).Delete
    End If
  Next
End With

Set List = Nothing
End Sub

Answer 1

I'm not sure if this does exactly what you wants, but it does something very similar. To be clear:

Marks the cell adjacent to the list of names in Sheet1, if the name is found, then subsequently deletes the entire row if the the cell in said adjacent column is empty.

Sub Macro()

Dim r As Long
Dim r2 As Long
Dim counter As Long
Dim counter2 As Long


Range("O1").Select
Selection.End(xlDown).Select
r = ActiveCell.Row

Sheets(ActiveSheet.Index + 1).Select
Range("A1").Select
Selection.End(xlDown).Select
r2 = ActiveCell.Row
Range("A1").Select
For counter = 1 To r2
needle = ActiveCell.Value
Sheets(ActiveSheet.Index - 1).Select
On Error GoTo NotFound
Range(Cells(1, 15), Cells(r, 15)).Find(needle).Select
Selection.Offset(0, 1).Value = "found"
NotFound:
Sheets(ActiveSheet.Index + 1).Select
Selection.Offset(1, 0).Select


Next

Sheets(ActiveSheet.Index - 1).Select
Range("P1").Select
For counter2 = 1 To r
If ActiveCell.Value = "" Then Selection.EntireRow.Delete
Selection.Offset(1, 0).Select

Next

Cleanup:

Range("P1:P10000").Value = ""

End Sub

It is however, rather ugly and inefficient code. Lmk if there's something that needs changing!

Answer 2

i would do it like this:

Dim i as integer
dim x as integer
Dim rngSearch as Range
Dim strName as String
Dim ws1 as Worksheet
dim ws2 as Worksheet

Set ws1 = Thisworkbook.worksheets(1)
Set ws2 = Thisworkbook.worksheets(2)

x = ws1.cells(ws1.rows.count,1).end(xlup).row
for i = 2 to x
     strName = ws1.cells(i, 1)
     set rngSearch = ws2.columns(15).find(strName)
     if rngSeach is nothing then
          ws1.rows(i).entirerow.delete
          i = i-1
     end if
next i

It's not tested but it should work like this.

Edit: I think you have to put the worksheets in right order. I think i mixed them up here.