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
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
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
How many locations, not on your paper list, are there?
 
Upvote 0
or could you put this list of locations in an excel sheet attached to the workbook of your report? or perhaps in a separate workbook that will never ever be moved or deleted??
if so tell me which method, where the sheet appears in the workbook, and what the sheet name is.
 
Last edited:
Upvote 0
This should achieve what you want if you create a sheet named "Locations" that has all of the locations in column A with no blanks
As well just run this on the active sheet where you are trying to remove said locations. if the location is an exact match to the one on your paper it will remove the row.

Code:
Sub locationDELETE()
Dim ary1 As Variant, ary2 As Variant, ary3 As Variant
Dim os As Worksheet, ws As Worksheet
Dim i As Long, j As Long, x As Long, k As Long

Set os = ActiveSheet
Set ws = Sheets("Locations")

ary1 = os.Range("A1").CurrentRegion.Value2
ary2 = ws.Range("A1").CurrentRegion.Value2
ReDim ary3(1 To UBound(ary1), 1 To UBound(ary1, 2))

For i = 2 To UBound(ary1)
    For x = LBound(ary2) To UBound(ary2)
        If ary1(i, 6) = ary2(x, 1) Then
            j = j + 1
                For k = 1 To UBound(ary1, 2)
                ary3(j, k) = ary1(i, k)
                Next k
        End If
    Next x
Next i

os.Rows(2 & ":" & os.Rows.Count).Delete
os.Range("A2").Resize(j, UBound(ary3, 2)).Value = ary3

End Sub
 
Upvote 0
Hi
you might try this code
your location list are in Sheet2 columna

and run this code from your report sheet

Code:
Sub test()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    List = Application.Transpose(Sheets("sheet2").Range("a1").Resize(Cells(Rows.Count, 1).End(xlUp).Row))
    my_list = "(" & Join(Split(Join(List, " ("), " "), ")|") & ")"
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = my_list
        For j = 1 To lr
            If Not .test(Cells(j, 7)) Then
                 Cells(j, 7).EntireRow.Delete
            End If
        Next
    End With
End Sub
 
Last edited:
Upvote 0
Sorry
forget the first code and try
Code:
Sub test()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    List = Application.Transpose(Sheets("sheet2").Range("a1").Resize(Cells(Rows.Count, 1).End(xlUp).Row))
    my_list = "(" & Join(Split(Join(List, " ("), " "), ")|") & ")"
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = my_list
        For j = 1 To lr
            If Not .test(Cells(j, 7)) Then
                 Cells(j, 7).EntireRow.Delete
            End If
        Next
    End With
End Sub
 
Upvote 0
Hi
I must sleepy
here is the tested working code(the final)
Code:
Sub test()
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("sheet2")
        llist = .Cells(Rows.Count, 1).End(xlUp).Row
        List = Application.Transpose(Sheets("sheet2").Range("a1").Resize(llist))
    End With
    my_list = "(" & Join(Split(Join(List, " ("), " "), ")|") & ")"
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = my_list
        For j = 1 To lr
            If Not .test(Cells(j, 6)) Then
                Cells(j, 6).EntireRow.Delete
            End If
        Next
    End With
End Sub
 
Last edited:
Upvote 0
Thank you so much for responding and I'm sorry it took awhile for me to try your suggestions.
I received an error from both subs, so I tried to be more specific a bit further down in this response.

Both of these give me an error:
Application Defined or Object Defined error.

BlakeSkate, yours occurs at your last line of code: os.Range("A2").Resize(j, UBound(ary3, 2)).Value = ary3

mohadin, yours occurs at line 12: If Not .test(Cells(j, 6)) Then

Just to clarify:
My column headers, in the sheet that contains the exported data ("Sheet1"), are, in order:

BedID, Name, PersonID, Start Time, End Time, Location, SubArea, MAN

On the second sheet ("Sheet2") is my list of locations TO KEEP. Row 1 is a header row, row 2 begins the list.
So, if a location on sheet 1 matches a location on Sheet2, then I KEEP that row, and continue on to the next row to check.
If it doesn't match, then I delete the row, and continue on to the next row to check.
The number of rows that are on the first sheet (Sheet1) is always dynamic (This is the sheet that contains the data exported from the database and has the 8 columns of data.
The number of rows on my sheet that contains my list of locations (Sheet2) to keep is always dynamic also.

Does this help?

-Christine
 
Upvote 0
Seems to be a bit of inconsistency with how big the data is. You initially said columns A-G (7) but then in post 8 you said 8 columns and gave 8 headings.

In any case, you should be able to do them all at once instead of checking a row at a time. Try this in a copy of your workbook.

Code:
Sub Delete_Unwanted_Locations()
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
    .Activate
    With .Range("I2:I" & .Range("F" & .Rows.Count).End(xlUp).Row)
      .Value = Evaluate("match(" & .Offset(, -3).Address & ",Sheet2!A$1:A" & Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row & ",0)")
      On Error Resume Next
      .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
      On Error GoTo 0
      .ClearContents
    End With
  End With
  Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Hi Christine
Please Try this and tell me
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, " ("), " "), ")|") & ")"
    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
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,177
Members
448,554
Latest member
Gleisner2

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