Delete rows if cell value is not contained on a list

Rackette

New Member
Joined
Jul 2, 2019
Messages
37
This is like being a boat owner...there are always things that don't work right, but when most things work, it's really quite fun.

I export a report out of a database.
The 1st ROW is the header row.
The 2nd row is where the data begins.
The 6th column contains "Locations".
The number of rows is dynamic, but is usually between 1000 ad 1030.
The data is only in columns A - G.

On a paper, I have a list of about 30 locations.

Currently, I have to manually go through the spreadsheet and delete the rows that do NOT have a location that is on my paper list.

How do I get a macro that will 'compare and delete' where needed?

-Christine
 
Please Try this and tell me
I have tried that. There may be other problems too but the first thing that occurred to me is that you don't appear to have thought of or tested(?) where a location to keep may consist of more than one word (eg New York). Your RegExp pattern looks very unusual in that circumstance & still results in the error reported in post 8
 
Last edited:
Upvote 0

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
I have tried that. There may be other problems too but the first thing that occurred to me is that you don't appear to have thought of or tested(?) where a location to keep may consist of more than one word (eg New York). Your RegExp pattern looks very unusual in that circumstance & still results in the error reported in post 8

Wow....
You are absolutely right
I tested for one word location (OK)
so, would you tell me if you have any notes on this
I do appreciate it
Code:
Sub test()
    Dim ret As Range, itm As Range
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("sheet2")
        llist = .Cells(Rows.Count, 1).End(xlUp).Row - 1
        List = Application.Transpose(Sheets("sheet2").Range("a2").Resize(llist))
    End With
    my_list = "(" & Join(Split(Join(List, Chr(164) & "("), Chr(164)), ")|") & ")"
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = my_list
        For j = lr To 2 Step -1
            If .test(Cells(j, 6)) Then
            Else
                Cells(j, 6).EntireRow.Delete
            End If
        Next
    End With
End Sub
I fixed the Pattern
Thank you very much in deed
 
Last edited:
Upvote 0
Peter, as always, yours worked perfectly. AND I was actually able to follow what it was doing. :) Thank you!

mohadin, thank you for taking the time to try to make it work. I received another "Application defined or Object defined" error.
Debug showed this highlighted in yellow: If .test(Cells(j, 6)) Then

-Christine
 
Upvote 0
I'm sorry. I actually replied to this, but I think it timed out on me and my response didn't actually get posted.

Peter, your code worked just as I needed it to. Thank you! :)

mohadin, when I ran yours, I received another Application Defined or Object Defined error.
It ocurred at: For j = lr To 2 Step -1

Thank you both for your help. :)

-Christine
 
Upvote 0
Peter, as always, yours worked perfectly. AND I was actually able to follow what it was doing. :) Thank you!
You are very welcome. :)



so, would you tell me if you have any notes on this
Since you asked, I do.
1. Since we are looking to match or not match exact locations, not searching for text within longer strings, regular expressions are an inefficient way to approach the problem. See also alternative code below.

2. Your code interacts with the worksheet many times - each cell value is retrieved from the worksheet one at a time and whenever there is a row deletion to do your code interacts with the worksheet again. Such interactions between code and worksheet are relatively slow. For example, your last code is about 20 times slower than the one I posted earlier and one of the reasons for the difference is those constant interactions.

3. Your red code below is a somewhat awkward way to achieve the row deletion when required. A much simpler way would be the single blue code line.
Rich (BB code):
If .test(Cells(j, 6)) Then
Else
  Cells(j, 6).EntireRow.Delete
End If

If Not .test(Cells(j, 6)) Then Rows(j).Delete

4. You have declared some of your variables with Dim statements, but not all. I would highly recommend declaring all variables. You can easily force yourself to do that by, in the vba window, Tools -> Options -> Editor tab -> Require Variable Declaration -> OK

5. Your code relies on Sheet1 being the active sheet when the code is run. It would be more robust if you didn't have to rely on that being the case.

6. Your code still does not not work correctly. For example, with the location values shown below, South London and Londonderry should be removed from Sheet1 but your code does not remove them because they contain the text "London". This relates to my point 1 above.

Sheet1
London
South London
Londonderry
New York

Sheet 2
London
New York

IF we were to approach the problem by looping through the rows, & I'm not suggesting that approach at all, then here is a way that addresses points 1, 5 & 6 and uses vba's built-in string functions which should be more efficient than using RegExp.

Rich (BB code):
Sub testagain()
  Dim r As Long
  Dim List As String

  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    List = "|" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp))), "|") & "|"
  End With
  With Sheets("Sheet1")
    For r = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
      If InStr(1, List, "|" & .Cells(r, 6).Value & "|", vbTextCompare) = 0 Then .Rows(r).Delete
    Next r
  End With
  Application.ScreenUpdating = True
End Sub

Finally, if speed was an issue, and it shouldn't be for the thousand or so rows for this OP, here is a very fast way to do the deletions - about twice as fast as the code I posted in post 9. This code only interacts with the sheets 5 times:
- once to get the list from Sheet2
- once to get all the column F values from Sheet1
- once to write a column of values back to Sheet1
- once to sort
- once to do all the row deletions at once.

Rich (BB code):
Sub testfast()
  Dim r As Long, k As Long
  Dim List As String
  Dim a As Variant, b As Variant
   
  With Sheets("Sheet2")
    List = "|" & Join(Application.Transpose(.Range("A2", .Range("A" & .Rows.Count).End(xlUp))), "|") & "|"
  End With
  With Sheets("Sheet1")
    With .Range("A2:I" & .Range("A" & .Rows.Count).End(xlUp).Row)
      a = .Columns(6).Value
      ReDim b(1 To UBound(a), 1 To 1)
      For r = 1 To UBound(a)
        If InStr(1, List, "|" & a(r, 1) & "|", vbTextCompare) = 0 Then
          b(r, 1) = 1
          k = k + 1
        End If
      Next r
      If k > 0 Then
        Application.ScreenUpdating = False
        .Columns(.Columns.Count).Value = b
        .Sort Key1:=.Columns(.Columns.Count), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
        Application.ScreenUpdating = True
      End If
    End With
  End With
End Sub
 
Upvote 0
Hi Mr Peter
First, I would like to thank you very much for your reply
Now
Your point 1
About the exact match
googling this staff had this
Optional ParametersTypeDescription
GlobalBooleanIf set to True, all matches will be returned ("greedy matching"). If set to False, only the first match will be returned ("lazy matching"). The default value is False.
IgnoreCaseBooleanIf set to True, the pattern matching will be case-insensitive. The default value is False (case-sensitive).
MultiLineBooleanIf set to True, it changes the interpretation of the ^ ("beginning of string") and $ ("end of string") meta-characters in the search pattern so that they match the beginning and end of aline instead. The default value is False.

<tbody style="box-sizing: border-box;">
</tbody>
I'm not insisting Regexp but just me to understand it well
Point 2 ,3
You are correct 100%
Point 4
well I did the setting you mentioned but (bad me) I always deleting it (I well commit to your advice from now on) Thanks
Point 5
Again You are 100% right
Point 6
Agree with you
A you Codes are fantastic for this situation (Always)

Since I'm Here, May I ask you about this bit of codding
Code:
For j = 1 To UBound(a)
            If Not a(j) <> "bla" Then
                If Not total_rng Is Nothing Then
                    Set rng = Range("f" & j + 1)
                    Set total_rng = Union(total_rng, rng)
                Else
                    Set total_rng = Range("f" & j + 1)
                End If
            End If
        Next
Talking about (set rng = range(xxxx) is this line of code interacts with the sheet?

At the end I would thank you very very much, I learned lots of thing from you Thank you again and excuse my bad
English
Thank s
 
Upvote 0
Your point 1
About the exact match
googling this staff had this
Optional ParametersTypeDescription
GlobalBooleanIf set to True, all matches will be returned ("greedy matching"). If set to False, only the first match will be returned ("lazy matching"). The default value is False.
IgnoreCaseBooleanIf set to True, the pattern matching will be case-insensitive. The default value is False (case-sensitive).
MultiLineBooleanIf set to True, it changes the interpretation of the ^ ("beginning of string") and $ ("end of string") meta-characters in the search pattern so that they match the beginning and end of aline instead. The default value is False.

<tbody style="box-sizing: border-box;">
</tbody>
I'm not sure what you are getting at with this but it has nothing to do with partial/complete matches.


Since I'm Here, May I ask you about this bit of codding
Sorry, I don't think we should hijack the OP's thread and head off regarding other code.
 
Upvote 0
I'm not sure what you are getting at with this but it has nothing to do with partial/complete matches.


Sorry, I don't think we should hijack the OP's thread and head off regarding other code.

Hi Mr. Peter
It is not Hijacked
I was trying this code
Code:
Sub test()
    Dim total_rng As Range
    Dim rng As Range
    Dim lr As Long
    Dim llist
    Dim list As Variant
    Dim a As Variant
    Dim j
    Dim my_list As String
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("sheet2")
        llist = .Cells(Rows.Count, 1).End(xlUp).Row - 1
        my_list = "(" & Join(Application.Transpose(.Range("a2", .Range("a" & llist + 1))), ")|(") & ")"
    End With
    a = Application.Transpose(Cells(2, 6).Resize(lr - 1))
    With CreateObject("VBScript.RegExp")
        .Global = False
        .Pattern = my_list
        For j = 1 To UBound(a)
          If Not total_rng Is Nothing Then
                If Not total_rng Is Nothing Then
                    Set rng = Range("f" & j + 1)
                    Set total_rng = Union(total_rng, rng)
                Else
                    Set total_rng = Range("f" & j + 1)
                End If
            End If
        Next
        total_rng.Select
    End With
End Sub
 
Last edited:
Upvote 0
Exactly Sir
It is general question about coding technique
Thanks
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,937
Members
448,534
Latest member
benefuexx

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