vba to delete rows based on cell values in a column

[cjcass]

Hi,
I'm looking for a macro/vba that will delete all the rows in the table (from A11 down) where the row's value in Col B doesn't match any of the values present in cells D2:D8. So in this example the result is that the rows highlighted in orange are deleted and the table height is adjusted accordingly. The table from A11 can vary in it's number of rows down and some of the cells in D2:D8 may be empty (as shown).
Any help would be much appreciated.
Thanks.

 

[DanteAmor]

I'm looking for a macro/vba that will delete all the rows in the table

The data is inside a table? or is the data in the normal range of cells?
If it is a table, are the headings in row 10?

 

[DanteAmor]

I put the 2 versions here.

For range

Sub Delete_Rows_Range()
  Dim arr1() As Variant, arr2() As Variant
  Dim lr As Long, i As Long
  Dim dic1 As Object, dic2 As Object
  
  lr = Range("B" & Rows.Count).End(3).Row
  arr1 = Range("D2:D8").Value2
  arr2 = Range("B11:B" & lr).Value
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  For i = 1 To UBound(arr1)
    If arr1(i, 1) <> "" Then dic1(arr1(i, 1)) = Empty
  Next
  For i = 1 To UBound(arr2)
    If Not dic1.exists(arr2(i, 1)) Then dic2(arr2(i, 1)) = Empty
  Next
  If dic2.Count > 0 Then
    Range("B10:B" & lr).AutoFilter 1, dic2.keys, xlFilterValues
    lr = Range("B" & Rows.Count).End(3).Row
    If lr > 10 Then ActiveSheet.AutoFilter.Range.Offset(1).EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
End Sub

For table

Sub Delete_Rows_Table()
  Dim arr1() As Variant, arr2() As Variant
  Dim lr As Long, i As Long
  Dim dic1 As Object, dic2 As Object
  
  lr = Range("B" & Rows.Count).End(3).Row
  arr1 = Range("D2:D8").Value2
  arr2 = Range("B11:B" & lr).Value
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  
  For i = 1 To UBound(arr1)
    If arr1(i, 1) <> "" Then dic1(arr1(i, 1)) = Empty
  Next
  For i = 1 To UBound(arr2)
    If Not dic1.exists(arr2(i, 1)) Then dic2(arr2(i, 1)) = Empty
  Next
  If dic2.Count > 0 Then
    ActiveSheet.ListObjects("Table1").Range.AutoFilter 2, dic2.keys, xlFilterValues
    lr = Range("B" & Rows.Count).End(3).Row
    If lr > 10 Then ActiveSheet.AutoFilter.Range.Offset(1).EntireRow.Delete
    ActiveSheet.ShowAllData
  End If
End Sub

 

[cjcass]

Hi,
The data is in a normal range of cells.
I have tried your first solution 'For range' and it works perfectly!!
Thanks very much for your time on this
Best Regards.

 

[DanteAmor]

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