vba Delete Row(s) not matching table criteria Macro

[NGB82KS]

So i'll do my best to try and explain this.
I have a spreadsheet with 2 tabs (DataExport; FilterCriteria)
The DataExport tab is every computer i pulled from active directory (real long list) Column A is the PC name and Column B is the OU it resides in.
The FilterCriteria tab Column A is a list of the PC names that I would be looking for.
Note* Our PC naming conventions have gone through some changes, so i need the search to look for anything that begins, ends or contains the computer name in Column A of the FilterCriteria tab.

I need to be able to execute a macro that Deletes all rows from the DataExport tab that doesn't match the name filters in Column A/Name table of the FilterCriteria tab. Any help would be greatly appreciated.

 

[DanteAmor]

Take a test on a copy of your book.
Check if it is fast enough.
The macro assumes that the data begins in row 2 on both sheets.

Sub Delete_Row_1()
  Dim arr As Variant, i As Long, j As Long, lr As Long
  Dim a As Variant, b As Variant, r As Range
  Dim sh1 As Worksheet, sh2 As Worksheet, exists As Boolean
  
  Application.ScreenUpdating = False
  '
  Set sh1 = Sheets("DataExport")
  Set sh2 = Sheets("FilterCriteria")
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
  a = sh1.Range("A2:A" & lr).Value2
  b = sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp)).Value
  Set r = sh1.Range("A" & lr + 1)
  For i = 1 To UBound(a)
    exists = False
    For j = 1 To UBound(b)
      If a(i, 1) Like "*" & b(j, 1) & "*" Then
        exists = True
        Exit For
      End If
    Next
    If exists = False Then Set r = Union(r, sh1.Range("A" & i + 1))
  Next
  r.EntireRow.Delete
End Sub

 

[JLGWhiz]

Try this on a copy of your worksheets before running on the originals.

Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, fn As Range, rary As Variant
Set sh1 = Sheets("FilterCriteria")
Set sh2 = Sheets("DataExport")
rary = Application.Transpose(sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp)))
    With sh2
        For i = sh2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            For j = LBound(rary) To UBound(rary)
                If InStr(.Cells(i, 1), rary(j)) > 0 Then
                    Exit For
                End If
                If j = UBound(rary) Then Rows(i).Delete
            Next
        Next
    End With
End Sub

 

[NGB82KS]

Take a test on a copy of your book.
Check if it is fast enough.
The macro assumes that the data begins in row 2 on both sheets.

Sub Delete_Row_1()
  Dim arr As Variant, i As Long, j As Long, lr As Long
  Dim a As Variant, b As Variant, r As Range
  Dim sh1 As Worksheet, sh2 As Worksheet, exists As Boolean
 
  Application.ScreenUpdating = False
  '
  Set sh1 = Sheets("DataExport")
  Set sh2 = Sheets("FilterCriteria")
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
  a = sh1.Range("A2:A" & lr).Value2
  b = sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp)).Value
  Set r = sh1.Range("A" & lr + 1)
  For i = 1 To UBound(a)
    exists = False
    For j = 1 To UBound(b)
      If a(i, 1) Like "*" & b(j, 1) & "*" Then
        exists = True
        Exit For
      End If
    Next
    If exists = False Then Set r = Union(r, sh1.Range("A" & i + 1))
  Next
  r.EntireRow.Delete
End Sub

This looks like it works perfectly....... you are amazing!

 

[JLGWhiz]

wave the magic wand!

 

[DanteAmor]

Glad we could help & thanks for the feedback

 

[NGB82KS]

Ok, 1 last followup.
When i had my original code (but was only 1 computer name type) i had the following code which counted the number of rows and displayed it in a box which gave me the option for yes to delete or no, incase i saw something glaringly wrong. Can i still incorporate this into the script above? i've been trying to test it but only get a box but its not counting what it will delete..

'Count Rows & display message
On Error Resume Next
lRows = WorksheetFunction.Subtotal(103, lo.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible))
On Error GoTo 0

vbAnswer = MsgBox(lRows & " Rows will be deleted. Do you want to continue?", vbYesNo, "Delete Rows Macro")

If vbAnswer = vbYes Then

'Delete Rows
Application.DisplayAlerts = False
lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True

'Clear Filter
lo.AutoFilter.ShowAllData
End If

If vbAnswer = vbNo Then
'Clear Filter
lo.AutoFilter.ShowAllData

End If

 

[DanteAmor]

Try this

Sub Delete_Row_1()
  Dim arr As Variant, i As Long, j As Long, lr As Long
  Dim a As Variant, b As Variant, r As Range
  Dim sh1 As Worksheet, sh2 As Worksheet, exists As Boolean, vbAnswer As Variant
  
  Application.ScreenUpdating = False
  '
  Set sh1 = Sheets("DataExport")
  Set sh2 = Sheets("FilterCriteria")
  If sh1.AutoFilterMode Then sh1.AutoFilterMode = False
  lr = sh1.Range("A" & Rows.Count).End(xlUp).Row
  a = sh1.Range("A2:A" & lr).Value2
  b = sh2.Range("A2", sh2.Range("A" & Rows.Count).End(xlUp)).Value
  Set r = sh1.Range("A" & lr + 1)
  For i = 1 To UBound(a)
    exists = False
    For j = 1 To UBound(b)
      If a(i, 1) Like "*" & b(j, 1) & "*" Then
        exists = True
        Exit For
      End If
    Next
    If exists = False Then Set r = Union(r, sh1.Range("A" & i + 1))
  Next
  vbAnswer = MsgBox(r.Rows.Count - 1 & " Rows will be deleted. Do you want to continue?", vbYesNo, "Delete Rows Macro")
  If vbAnswer = vbYes Then r.EntireRow.Delete
End Sub

 

[NGB82KS]

So the Code doesn't give me any errors, but displays 0 rows to delete. But i know for a fact that there are about 100 rows (manually counted) from the list that don't match the filter. I tried using the original code as well but still get 0 as a result. I realize this isnt your problem, but when i recreate the excel ina brand new sheet it seems to work until i import all the data and then i get 0 results. In the attached picture the filter shows that row 1 should get deleted. does it have anything to do with the "-" or the fact that the other columns have data?

 

[DanteAmor]

Change

  vbAnswer = MsgBox(r.Rows.Count - 1 & " Rows will be deleted. Do you want to continue?", vbYesNo, "Delete Rows Macro")

For this:

  vbAnswer = MsgBox(r.Cells.Count - 1 & " Rows will be deleted. Do you want to continue?", vbYesNo, "Delete Rows Macro")