remove uniques between sheets

[emukiss10]

Hello,

- Sheets(1) column F from F2 to FXXX has some numbers
- Sheets(2) column E from E2 to EXXX has some numbers

I need to remove all rows in Sheets(2) based on those numbers (E) that are not present in Sheets(1) (F)

Please Help with VBA

Best Regards
W.

 

[Fluff]

Untested, but try this

Sub RemoveOddsies()

   Dim Cl As Range
   Dim Rng As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Sheets(1).Range("F2", Sheet(1).Range("F" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then .Add Cl.Value, Nothing
      Next Cl
      For Each Cl In Sheets(2).Range("E2", Sheets(2).Range("E" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            If Rng Is Nothing Then
               Set Rng = Cl
            Else
               Set Rng = Union(Rng, Cl)
            End If
         End If
      Next Cl
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
      
End Sub

 

[emukiss10]

It worked Fluff.. like always Thank you so much.

 

[Fluff]

Glad we help & thanks for the feedback

 

[hiker95]

Try the following macro (you can change the worksheet names in the macro):

Sub emukiss10()
' hiker95, 12/22/2017, ME1036307
Dim w1 As Worksheet, w2 As Worksheet
Dim r As Long, lr As Long, f As Range
Set w1 = Sheets("Sheets(1)")   '<-- you can change the sheet name here
Set w2 = Sheets("Sheets(2)")   '<-- you can change the sheet name here
With w2
  lr = .Columns(5).Find("*", searchdirection:=xlPrevious).Row
  For r = lr To 2 Step -1
    Set f = w1.Columns(6).Find(.Cells(r, 5).Value, LookAt:=xlWhole)
    If Not f Is Nothing Then
      .Rows(r).Delete
    End If
  Next r
End With
End Sub