Delete rows if cell value is not contained on a list

[Rackette]

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

 

[JoeMo]

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?

 

[DataBlake]

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.

 

[DataBlake]

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.

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

 

[mohadin]

Hi
you might try this code
your location list are in Sheet2 columna

and run this code from your report sheet

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

 

[mohadin]

Sorry
forget the first code and try

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

 

[mohadin]

Hi
I must sleepy
here is the tested working code(the final)

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

 

[Rackette]

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

 

[Peter_SSs]

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.

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

 

[mohadin]

Hi Christine
Please Try this and tell me

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