Delete Rows Based on Data in Separate Worksheet

To Attach a File:

1. Scroll down to the window below your post Additional Options
2. In the frame Attach Files you will see the button Manage Attachments
3. Click the button.
4. A new window will open titled Manage Attachments - Excel Forum.
5. Click the Browse... button to locate your file for uploading.
6. This will open a new window File Upload.
7. Once you have located the file to upload click the Open button. This window will close.
8. You are now back in the Manage Attachments - Excel Forum window.
9. Click the Upload button and wait until the file has uploaded.
10. Close the window and then click Submit.

http://www.excelforum.com/album.php?...hmentid=149278

Hi Smitty7,

Perhaps:

Sub DelURL(): Dim List1 As Worksheet, List2 As Worksheet
Dim e1 As Long, e2 As Long, i As Long, j As Long
Set List1 = Worksheets("List1"): Set List2 = Worksheets("List2")
e2 = List2.Range("A" & Rows.Count).End(xlUp).Row
e1 = List1.Range("A" & Rows.Count).End(xlUp).Row
For i = i To e2
For j = 1 To e1
DumpedURL:
If InStr(1, List2.Cells(j, 1), List1.Cells(i, 1)) Then
List2.Cells(j, 1).EntireRow.Delete Shift:=xlUp
GoTo DumpedURL: e1 = e1 - 1: End If
Next j
Next i
End Sub

Hi Smitty7,

Try this while on the tab to have the items deleted, though initially from a copy of data as the results cannot be undone if they're not as expected:

Option Explicit
Sub Macro1()

    'http://www.excelforum.com/excel-programming/846630-delete-rows-based-on-data-in-separate-worksheet.html
    
    Dim lngMyCol As Long, _
        lngMyRow As Long
        
    lngMyCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    lngMyRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
    Application.ScreenUpdating = False
    
    With Columns(lngMyCol)
        With Range(Cells(1, lngMyCol), Cells(lngMyRow, lngMyCol))
            .Formula = "=IF(ISERROR(VLOOKUP(LEFT(MID(A1,SEARCH(""http"",A1),255),SEARCH(""["",MID(A1,SEARCH(""http"",A1)+1,255))),Sheet2!A:A,1,FALSE)),"""",""DEL"")"
            .Value = .Value
        End With
        .Replace "DEL", "#N/A", xlWhole
        On Error Resume Next 'Turn error reporting off - OK to ignore 'No cells found' message
            .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
        On Error GoTo 0 'Turn error reporting back on
        .Delete
    End With
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

Hi Smitty7,

It's fixed but a trifle slow - it leaves you with 8121 rows in Sheet1:

Sub DelURL(): Dim List1 As Worksheet, List2 As Worksheet
Dim e1 As Long, e2 As Long, i As Long, j As Long
Set List1 = Worksheets("Sheet1"): Set List2 = Worksheets("Sheet2")
e2 = List2.Range("A" & Rows.Count).End(xlUp).Row
e1 = List1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To e2
For j = 1 To e1
DumpedURL:
If InStr(1, List1.Cells(j, 1), List2.Cells(i, 1)) Then
List1.Cells(j, 1).EntireRow.Delete Shift:=xlUp
e1 = e1 - 1: GoTo DumpedURL: End If
Next j
Next i
End Sub

You're welcome!

fyi it would likely be a lot faster to create a range of all the matching cells using Union and then delete that range in one hit at the end instead of deleting one row at a time.

fyi it would likely be a lot faster to create a range of all the matching cells using Union and then delete that range in one hit at the end instead of deleting one row at a time

My code deletes an entire block in one go?

yes it does. xladept's code doesn't though-I should have made clear to whom I was addressing the comment.

Oh OK, I see. Thanks for the clarification.

I didn't realize that block deletions were appropriate to the data - I'll look harder in the future.