Not detecting all arrays

Mux99

Board Regular
Joined
Apr 15, 2019
Messages
57
I'm using the code below to delete all rows that don't contain a list of words. For some reason it is deleting the cell that contains the word Apple and keeps the other three with Banana, Orange & Apple Tree. Hopefully someone can help me out.

Also is it possible to search for Apple and automatically detect all cells containing that word? Ex. Apple, Apple Tree etc...

Sub DeleteRows() Dim FirstRow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim Testt As Variant
Testt = Array("Banana", "Apple", "Orange", "Apple Tree")
With ActiveSheet
.Select
FirstRow = .UsedRange.Cells(1).Row
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = LastRow To FirstRow Step -1
With .Cells(Lrow, "D")
If Not UBound(filter(Testt, .Value, True, vbTextCompare)) = 0 Then .EntireRow.Delete
End With
Next Lrow
End With
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Try
Code:
If UBound(Filter(Testt, .Value, True, vbTextCompare)) >= 0 Then .EntireRow.Delete
 
Upvote 0
To delete rows where the cell contains a value in the array try
Code:
Sub Mux99()
   Dim Cl As Range, Rng As Range
   Dim i As Long
   Dim Ary As Variant
   
   Ary = Array("Banana", "Apple", "Orange")
   For Each Cl In Range("D2", Range("D" & Rows.Count).End(xlUp))
      For i = 0 To UBound(Ary)
         If InStr(1, Cl, Ary(i), 1) > 0 Then
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
            Exit For
         End If
      Next i
   Next Cl
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub
 
Upvote 0
Try
Code:
If UBound(Filter(Testt, .Value, True, vbTextCompare)) >= 0 Then .EntireRow.Delete

This fixed the issue. Thanks

To delete rows where the cell contains a value in the array try
Code:
Sub Mux99()
   Dim Cl As Range, Rng As Range
   Dim i As Long
   Dim Ary As Variant
   
   Ary = Array("Banana", "Apple", "Orange")
   For Each Cl In Range("D2", Range("D" & Rows.Count).End(xlUp))
      For i = 0 To UBound(Ary)
         If InStr(1, Cl, Ary(i), 1) > 0 Then
            If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
            Exit For
         End If
      Next i
   Next Cl
   If Not Rng Is Nothing Then Rng.EntireRow.Delete
End Sub

This one almost worked, it did the opposite of what I needed. I wanted to keep the rows containing the array and delete all other rows.

I'm wondering if it's possible to search for a mix of arrays, a few keywords like the above and some that have to be a perfect match?
 
Upvote 0
can you please post some (realistic) examples of your data & what you need.
 
Upvote 0
can you please post some (realistic) examples of your data & what you need.

I decided to stick with the first code that uses perfect match to avoid mistakes since some of the keywords I will be using are similar. Thanks for the help
 
Upvote 0
The below is almost working perfectly for what I need. It deletes all rows that don't contain the exact keywords in column D. There are some cells in column D with the word "OFF" in it and it is not deleting those rows for some reason. Any ideas?

Sub DeleteRows()
Dim FirstRow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim Vr As Variant
Vr = Array("Second Floor", "Back Entrance", "Front Entrance", "Main Office")
With ActiveSheet
.Select
FirstRow = .UsedRange.Cells(1).Row
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = LastRow To FirstRow Step -1
With .Cells(Lrow, "D")
If Not UBound(Filter(Vr, .Value, True, vbTextCompare)) >= 0 Then .EntireRow.Delete
End With
Next Lrow
End With
End Sub
 
Last edited:
Upvote 0
Filter looks for partial matches, so because OFF is in Office, it wont be deleted.
 
Upvote 0
How about
Code:
Sub DeleteRows()
   Dim FirstRow As Long
   Dim LastRow As Long
   Dim i As Long
   Dim Vr As Variant
   Vr = Array("Second Floor", "Back Entrance", "Front Entrance", "Main Office")
   With ActiveSheet
      FirstRow = .UsedRange.Cells(1).Row
      LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
      With .Range("D" & FirstRow & ":D" & LastRow)
         For i = 0 To UBound(Vr)
            .Replace Vr(i), "=XXX" & Vr(i), xlWhole, , False, , False, False
         Next i
         .SpecialCells(xlConstants).EntireRow.Delete
         .Replace "=XXX", "", xlPart, , False, , False, False
      End With
   End With
End Sub
 
Upvote 0
How about
Code:
Sub DeleteRows()
   Dim FirstRow As Long
   Dim LastRow As Long
   Dim i As Long
   Dim Vr As Variant
   Vr = Array("Second Floor", "Back Entrance", "Front Entrance", "Main Office")
   With ActiveSheet
      FirstRow = .UsedRange.Cells(1).Row
      LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
      With .Range("D" & FirstRow & ":D" & LastRow)
         For i = 0 To UBound(Vr)
            .Replace Vr(i), "=XXX" & Vr(i), xlWhole, , False, , False, False
         Next i
         .SpecialCells(xlConstants).EntireRow.Delete
         .Replace "=XXX", "", xlPart, , False, , False, False
      End With
   End With
End Sub

This worked with that worksheet but when I tried it with another one with different keywords it deleted some of the arrays with numbers included. Ex.

Vr = Array("First Floor", "Entrance 1A", "Entrance 2D", "Main Office, John's Office")
With the above it only detected First Floor & Main Office and deleted the rows with numbers and symbols in them.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,562
Messages
6,114,322
Members
448,564
Latest member
ED38

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