VBA-only delete rows based off cells that is not in another sheet

[Registered55]

Hello,

Sheet2 column a has strings that i want to be saved from sheet1

Sheet1 if column H does NOT contain string that is in sheet2 column A
then delete row.

So basically sheet2 contains the list of what i want to keep in sheet1, everything else delete.

sheet2 ColA needs to be dynamic as the list wil grow and shrink accordingly to changes i make.

Thanks.

Sheet1 contains around 10k rows.

 

[DanteAmor]

column H does NOT contain string that is in sheet2 column A

You mean the complete content of the cell or only a part.
You could give an example.

How many rows are on sheet2.
On sheet1 you have formulas, from which column to which column on sheet1 do you have information, I ask, because maybe it is faster to copy the rows that are going to be alive than to delete rows.

 

[DanteAmor]

The following macro, reviews the whole content of the cell, with 10,000 records run in 4 seconds.

Try an comment.

Change Sheet1 and Sheet2 for the names of your sheets.

Sub only_delete_rows()
  Dim a As Variant, b As Variant, r As Range, lr As Long, i As Long
  Dim sh As Worksheet, dic As Object

  Set sh = Sheets("Sheet1")
  Set dic = CreateObject("Scripting.Dictionary")
  dic.CompareMode = vbTextCompare

  lr = sh.Range("H" & Rows.Count).End(xlUp).Row
  a = sh.Range("H1:H" & lr).Value2
  b = Sheets("Sheet2").Range("A1", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Value2

  Set r = sh.Range("H" & lr + 1)
  For i = 1 To UBound(b)
    dic(b(i, 1)) = Empty
  Next
  For i = 1 To UBound(a)
    If Not dic.exists(a(i, 1)) Then Set r = Union(r, sh.Range("H" & i))
  Next
  r.EntireRow.Delete
End Sub

 

[Registered55]

ok...sorry i didn't explain properly.

sheet1 column H

FLRA3 
FLRA3S
FLRA4 
FLRA4S
FLRB3
FLRB3S
FLRB4
FLRB4S
FLSUP
FLSUP
IRA4
RB3
RB3S
RB4
RB4S
SUPBB

in sheet2 colA

RB3
RB4S
FLRB4

now i want to delete all the rows (not header) in sheet1 unless the cell in ColH contains the list of sheet2

so do not delete any row (in the example above):
RB3
RB4S
FLRB4
But delete all the other rows.

(thank you for replying and helping me with this, it's a project i'm trying to do at work...appreciate you helping).

Regards,

 

[Peter_SSs]

Give this a try in a copy of your workbook. I have assumed that headings in both sheets with actual data starting on row 2.

Sub Del_Rws()
  Dim d As Object
  Dim a As Variant, b As Variant, itm As Variant
  Dim nc As Long, i As Long, k As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Sheets("Sheet2").Range("A2", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)).Value
  For Each itm In a
    d(itm) = 1
  Next itm
  With Sheets("Sheet1")
    a = .Range("H2", .Range("H" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If Not d.exists(a(i, 1)) Then
        k = k + 1
        b(i, 1) = 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
      With .Range("A2").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

Interested in the answer to Dante's earlier question still though:

How many rows are on sheet2

 

[Registered55]

Hi,

sheet 2 will probably have around at the very maximum 100 for us, but maybe a hotel in london may have mmore rate codes, so perhaps lets say 500 at the very outset.

so maximum 500 in sheet2 ColA

and yes sheet2 will have a header, your right, this is better.

thanks,

 

[Registered55]

Just wanted to say thank you to you both, works great.

Regards,

 

[DanteAmor]

now i want to delete all the rows (not header) in sheet1

Just change in my macro 1 to 2 in this line:

For i = 2 To UBound(a)

________________

 

[Peter_SSs]

so maximum 500 in sheet2 ColA

Thanks. With that number of rows in Sheet2 and 10,000 in Sheet1, my code took about 0.2 seconds to run on my sample data. The actual speed of the codes will depend a little on how many rows there are to delete and how scattered they are throughout the rows in Sheet1.

Just wanted to say thank you to you both, works great.

You are very welcome.

 

[DanteAmor]

Just wanted to say thank you to you both, works great.

I'm glad to help you. Thanks for the feedback.