(VBA) Filter 14 different words, and delete rows that don't contain those words

[Animalised]

Hi Everyone,

This seems difficult.

I'm trying to delete rows if the text in cells in column B is not equal to specific registrations, examples being:

- ABC111
- ABC112
- ABC123
- ABC124
- ABC125
- ABC126
- ABC127
- ABC128
- ABC129
- ABC130
- ABC131
- ABC132
- ABC133
- ABC134

The registrations above need to be kept and any others deleted.


Any help would be greatly appreciated!

 

[MickG]

Try :-

[COLOR="Navy"]Sub[/COLOR] MG18Aug19
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Application.ScreenUpdating = False
Lst = Range("B" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Dic.Add "ABC111", ""
Dic.Add "ABC112", ""
Dic.Add "ABC123", ""
Dic.Add "ABC124", ""
Dic.Add "ABC125", ""
Dic.Add "ABC126", ""
Dic.Add "ABC127", ""
Dic.Add "ABC128", ""
Dic.Add "ABC129", ""
Dic.Add "ABC130", ""
Dic.Add "ABC131", ""
Dic.Add "ABC132", ""
Dic.Add "ABC133", ""
Dic.Add "ABC134", ""

[COLOR="Navy"]For[/COLOR] n = Lst To 1 [COLOR="Navy"]Step[/COLOR] -1
[COLOR="Navy"]With[/COLOR] Range("B" & n)
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(.Value) [COLOR="Navy"]Then[/COLOR] .EntireRow.Delete
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR]
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Animalised]

Hi Mick,

This worked a treat! You're brilliant from helping with this! Thank you very much!

 

[MickG]

You're welcome

 

[rplohocky]

Try :-

[COLOR="Navy"]Sub[/COLOR] MG18Aug19
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
Application.ScreenUpdating = False
Lst = Range("B" & Rows.Count).End(xlUp).Row
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Dic.Add "ABC111", ""
Dic.Add "ABC112", ""
Dic.Add "ABC123", ""
Dic.Add "ABC124", ""
Dic.Add "ABC125", ""
Dic.Add "ABC126", ""
Dic.Add "ABC127", ""
Dic.Add "ABC128", ""
Dic.Add "ABC129", ""
Dic.Add "ABC130", ""
Dic.Add "ABC131", ""
Dic.Add "ABC132", ""
Dic.Add "ABC133", ""
Dic.Add "ABC134", ""

[COLOR="Navy"]For[/COLOR] n = Lst To 1 [COLOR="Navy"]Step[/COLOR] -1
[COLOR="Navy"]With[/COLOR] Range("B" & n)
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(.Value) [COLOR="Navy"]Then[/COLOR] .EntireRow.Delete
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR]
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

Mick,
This code works great for specific words but can you modify it to work for cells that contain a variation of a keyword? For example, the cells in column F has something like 10BKT0098 in some of the rows, the macro should look through each cell to see if the keyword "BKT" is in it and keep it but delete every other row in the data set. I have a need for this for 3 different keywords as well. Thanks!