vba Delete Row(s) not matching table criteria Macro

NGB82KS

Board Regular
Joined
Nov 7, 2019
Messages
82
Office Version
  1. 2016
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.
 
After looking at the previous posts, I am unable to understand exactly what the problem is. Which sheet does the names with the dash marks appear? Could it be fixed by changing your filter criteria on the worksheet? Can you show a specific example of how a number would apppear on the filter sheet but not be identified on the DataExport sheet?

So on the filter tab, i have a filter listed as 104XX-DC-001 for the school location number, but on the DataExport tab my result is ACDE-DC-104v. Im asking is there a way to make the filter look only at everything before the - in the 104XX-DC-001 and not at the end which just happens that there are 104 systems there?
 
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
In the example you give, it would make no difference. The filter still would not find 104XX against 104v, If you just looked for 104 as part of a string, it would find that, but it could be in any combination and not necessarily the 104v.. You will likely have to handle the exceptions manually if you cannot extablish a standard on your filter sheet that can be matched to items on the Data sheet. Hopefully, there are only a few in that category.
 
Upvote 0
Hi NGB82KS,

Did you try the macro of post #19?
The macro worked fine from post #2, you just wanted a counter.

Let me know if the last one of post #19 works for you.
 
Upvote 0
Although I doubt it woill fix your issue, my original code has been modified to test for the value left of the first dash (-) symbol.

Code:
Sub t2()
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(rary(j), "-") > 0 Then
                    If InStr(.Cells(i, 1).Value, Left(rary(j), InStr(rary(j), "-") - 1)) > 0 Then
                        Exit For
                    End If
                ElseIf 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
 
Upvote 0
Hi NGB82KS,

Did you try the macro of post #19?
The macro worked fine from post #2, you just wanted a counter.

Let me know if the last one of post #19 works for you.

It didnt work even with generic data in a brand new spreadsheet. ill try to upload the test excel somewhere so you can see what i see incase i missed something in my copy paste. im traveling so it will be a day or two till i get access.
 
Upvote 0
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.

VBA Code:
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

@DanteAmor

If Sheets("FilterCriteria") have only 1 row at A2 to compare, it will error. Can you fix this error?. Thank you​

 
Upvote 0
If Sheets("FilterCriteria") have only 1 row at A2 to compare, it will error.
Hi @ngocanh87 , you have a good point.🙂

I add here the code for one row or several rows in the "FilterCriteria" sheet.

VBA Code:
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:A" & sh2.Range("A" & Rows.Count).End(xlUp).Row + 1).Value
  Set r = sh1.Range("A" & lr + 1)
  For i = 1 To UBound(a)
    exists = False
    For j = 1 To UBound(b) - 1
      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

I hope it helps you and those who have a similar situation.
With all pleasure, Dante Amor ;)
 
Upvote 1

Forum statistics

Threads
1,224,827
Messages
6,181,197
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top