Delete row base on other sheet

[cuetipper]

For each cell in workbook1 colum "A" i would like to compare that against a list stored in workbook2 and if it is found delete the entire row from workbook 1.
Additionally for the #'s in workbook2 if they do not exist in workbook1 delete that cell from workbook2. Also workbook2 would notrmally be closed when the macro from workbook1 is a activated. Can this be done? I have not the experience yet to do so alone. All support would be appreciated.

 

[mumps]

What is the full path to the folder containing workbook2? What is the full name of workbook2 including the extension (xlsx, xlsm)? What are the names of the sheets containing the lists in each workbook?

 

[cuetipper]

Workbook1 page name is "Open Vendors Jobs", Workbook2's "C:\Users\edward.selkov\Working\ExcludedWo's.xlsm" - worksheet name is "EXCWOS"

Thank you.

 

[mumps]

Copy/paste this macro in a standard module in Workbook1 and run it from there.

Sub DeleteRows()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, x As Long
    Set desWS = ThisWorkbook.Sheets("Open Vendors Jobs")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    Set srcWB = Workbooks.Open("C:\Users\edward.selkov\Working\ExcludedWo's.xlsm")
    Set srcWS = Sheets("EXCWOS")
    For Each Rng In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next Rng
    For x = LastRow To 2 Step -1
        If RngList.Exists(desWS.Cells(x, 1).Value) Then
            desWS.Rows(x).EntireRow.Delete
        End If
    Next x
    RngList.RemoveAll
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each Rng In desw.Range("A2", desw.Range("A" & desw.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next Rng
    For x = LastRow To 2 Step -1
        If Not RngList.Exists(srcWS.Cells(x, 1).Value) Then
            srcWS.Rows(x).EntireRow.Delete
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

Make sure you have backup copies of your files just in case something goes wrong.

 

[cuetipper]

Thanks for the quick reply. I did as you asked and on first run I get a subscript out of range on this line

Set desWS = ThisWorkbook.Sheets("Open Vendor Jobs")

 

[cuetipper]

I changed thisworkbook to active workbook and the first part of the code seems to work. Put now I get and undefined error here.

    For Each Rng In desw.Range("A2", desw.Range("A" & desw.Rows.Count).End(xlUp))

 

[mumps]

This line of code should work properly:

 Set desWS = ThisWorkbook.Sheets("Open Vendor Jobs")

Sometimes using "ActiveWorkbook" can give unexpected results. Double check the sheet name to make sure it is an exact match. Look for beginning or trailing spaces. If you still have problems, I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[cuetipper]

I replaced the line as descried and it failed again.
As for the sheet name I Copied and pasted the tab name to the code to be sure it was punctuated correctly.
I have sent you both test files for your review.
thank you.

https://drive.google.com/open?id=1F_gl9UGFFTUeLm5nwb5OkfF36toTxTts
https://drive.google.com/open?id=1I_b0Ij_R9WQfExqpe7cGOgUtRMySV8Lv

 

[mumps]

There were a few typo's on my part. Try:

Sub DeleteRows()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, x As Long
    Set desWS = ThisWorkbook.Sheets("Open Vendor Jobs")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim Rng As Range, RngList As Object
    Set RngList = CreateObject("Scripting.Dictionary")
    Set srcWB = Workbooks.Open("C:\Users\edward.selkov\Working\ExcludedWo's.xlsm")
    Set srcWS = Sheets("EXCWOS")
    For Each Rng In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next Rng
    For x = LastRow To 2 Step -1
        If RngList.Exists(desWS.Cells(x, 1).Value) Then
            desWS.Rows(x).EntireRow.Delete
        End If
    Next x
    RngList.RemoveAll
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each Rng In desWS.Range("A2", desWS.Range("A" & desWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next Rng
    For x = LastRow To 2 Step -1
        If Not RngList.Exists(srcWS.Cells(x, 1).Value) Then
            srcWS.Rows(x).EntireRow.Delete
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

 

[cuetipper]

Thank you. But this line still gives a subscript out of range error. If I change it to active workbooks it seems to run fine.

    Set desWS = ThisWorkbook.Sheets("Open Vendor Jobs")