Delete row if includes any value in array

[sandcastl3s]

This is a bit of a follow-up to my question here, where I inquired on using an array for in-string values to not delete a row. Thanks again to Peter, this saved me a ton of time.

I'm now trying to work out the opposite, more or less: to delete a row if any value in an array is present. I'm sure it's not much of a tweak to the existing solution but I can't for the life of me work it out.

Example: I have a list of thousands of names:

Will
William
Jim
Bob
Jim
Jimmy
James

The array is ("Will", "Jim")

The result would be

Bob
James

as at least one value in the array was present in all of the other rows.

~~

For reference, this is the scenario description and working script from the above-mentioned thread:

Will
William
Jim
Bob
Jim
Jimmy
James

The below script produces this after removing all rows that do not include any value in the array:

Will
William
Jim
Jim
Jimmy

[COLOR=darkblue]Sub[/COLOR][COLOR=#333333] Del_Rows()[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] a, b, dontDelete
  [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], j [COLOR=darkblue]As[/COLOR] Long
  
  dontDelete = Array("Will", "Jim")
  a = Range("A1").CurrentRegion.Value
  [COLOR=darkblue]ReDim[/COLOR] b(1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a), 1 [COLOR=darkblue]To[/COLOR] 1)
  [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a)
    [COLOR=darkblue]For[/COLOR] j = [COLOR=darkblue]LBound[/COLOR](dontDelete) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](dontDelete)
      [COLOR=darkblue]If[/COLOR] InStr(1, a(i, 1), dontDelete(j), vbTextCompare) > 0 [COLOR=darkblue]Then[/COLOR]
        b(i, 1) = 1
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] j
  [COLOR=darkblue]Next[/COLOR] i
  Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
  [COLOR=darkblue]With[/COLOR] Range("A1").Resize(UBound(a), 2)
    .Columns(2).Value = b
    .Sort Key1:=.Columns(2), Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] Next
    .Columns(2).SpecialCells(xlBlanks).EntireRow.Delete
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    .Columns(2).ClearContents
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR] [COLOR=darkblue]End[/COLOR][COLOR=darkblue]Sub[/COLOR]

I've tried hacking this code a thousand ways but can't get it to work. Any help is much appreciated!

 

[kalak]

I've tried hacking this code a thousand ways but can't get it to work. Any help is much appreciated!

Here's a 1001st way

Sub Del_Rows_2() 

Dim a, b, dontDelete
  Dim i As Long, j As Long
  
  dontDelete = Array("Will", "Jim")
  a = Range("A1").CurrentRegion.Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    For j = LBound(dontDelete) To UBound(dontDelete)
      If InStr(1, a(i, 1), dontDelete(j), vbTextCompare) > 0 Then GoTo nxti
    Next j
    b(i, 1) = 1
nxti:
  Next i
  Application.ScreenUpdating = False
  With Range("A1").Resize(UBound(a), 2)
    .Columns(2).Value = b
    .Sort Key1:=.Columns(2), Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    On Error Resume Next
    .Columns(2).SpecialCells(xlBlanks).EntireRow.Delete
    On Error GoTo 0
    .Columns(2).ClearContents
  End With
  Application.ScreenUpdating = True

  End Sub

 

[sandcastl3s]

Thanks for your reply @kalak!

I just ran it and it didn't work...I think I see what it's trying to do though but don't know how to fix it.

 

[kalak]

Thanks for your reply @kalak!

I just ran it and it didn't work...I think I see what it's trying to do though but don't know how to fix it.

With the data you posted it works and gives me the result that you asked for.
And it should do, since it's just a logical reverse, and minor modification, of your opening code which you said did work.
But since you don't say where, when, how or on which dataset(s) it didn't work for you, it's probably non-useful for me to offer any further input.

 

[Peter_SSs]

Try just making the 2 changes shown towards the end of the code.

[COLOR=darkblue]Sub[/COLOR][COLOR=#333333] Del_Rows()[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] a, b, dontDelete
  [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], j [COLOR=darkblue]As[/COLOR] Long
  
  dontDelete = Array("Will", "Jim")
  a = Range("A1").CurrentRegion.Value
  [COLOR=darkblue]ReDim[/COLOR] b(1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a), 1 [COLOR=darkblue]To[/COLOR] 1)
  [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a)
    [COLOR=darkblue]For[/COLOR] j = [COLOR=darkblue]LBound[/COLOR](dontDelete) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](dontDelete)
      [COLOR=darkblue]If[/COLOR] InStr(1, a(i, 1), dontDelete(j), vbTextCompare) > 0 [COLOR=darkblue]Then[/COLOR]
        b(i, 1) = 1
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] j
  [COLOR=darkblue]Next[/COLOR] i
  Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
  [COLOR=darkblue]With[/COLOR] Range("A1").Resize(UBound(a), 2)
    .Columns(2).Value = b
    .Sort Key1:=.Columns(2), Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] Next
    .Columns(2).SpecialCells([COLOR="#FF0000"]<del>xlBlanks</del>[B]xlConstants[/B][/COLOR]).EntireRow.Delete
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    <del>[COLOR="#FF0000"].Columns(2).ClearContents[/COLOR]</del>
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[sandcastl3s]

With the data you posted it works and gives me the result that you asked for.
And it should do, since it's just a logical reverse, and minor modification, of your opening code which you said did work.
But since you don't say where, when, how or on which dataset(s) it didn't work for you, it's probably non-useful for me to offer any further input.

I'm sorry kalak, you're right, I should have been more specific.
The dataset was in fact the example from my post, and another dataset with a lot more rows but a similar application.
More specifically, running the script did not make any changes to the existing dataset - no VB errors, just a flash of the script running with no changes to the data.
I don't know if it matters but I'm on an older version of Excel (2007).

Try just making the 2 changes shown towards the end of the code.

[COLOR=darkblue]Sub[/COLOR][COLOR=#333333] Del_Rows()[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] a, b, dontDelete
  [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], j [COLOR=darkblue]As[/COLOR] Long
  
  dontDelete = Array("Will", "Jim")
  a = Range("A1").CurrentRegion.Value
  [COLOR=darkblue]ReDim[/COLOR] b(1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a), 1 [COLOR=darkblue]To[/COLOR] 1)
  [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](a)
    [COLOR=darkblue]For[/COLOR] j = [COLOR=darkblue]LBound[/COLOR](dontDelete) [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](dontDelete)
      [COLOR=darkblue]If[/COLOR] InStr(1, a(i, 1), dontDelete(j), vbTextCompare) > 0 [COLOR=darkblue]Then[/COLOR]
        b(i, 1) = 1
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] j
  [COLOR=darkblue]Next[/COLOR] i
  Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
  [COLOR=darkblue]With[/COLOR] Range("A1").Resize(UBound(a), 2)
    .Columns(2).Value = b
    .Sort Key1:=.Columns(2), Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] Next
    .Columns(2).SpecialCells([COLOR=#FF0000]<del>xlBlanks</del>[B]xlConstants[/B][/COLOR]).EntireRow.Delete
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    <del>[COLOR=#FF0000].Columns(2).ClearContents[/COLOR]</del>
  [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

That did it Peter!

Thanks to both of you, I really appreciate it!

Is there a place to donate to this forum?

 

[Peter_SSs]

That did it Peter!

Thanks to both of you, I really appreciate it!

You are welcome. FYI, kalak's adaptation of the code also worked for me.

Is there a place to donate to this forum?

Not financially, this is a free forum.
As you feel able, you can always donate your time & knowledge to answer questions though.