VBA to delete rows if value matched across workbooks

[kbui92]

I have 2 workbooks, Workbook 1 & Delete. In "Delete", I have column A matched with value in column D in "Workbook 1"

What I want to do is, if value in Column A "Delete" matches with Column D "WB1", macro should delete entire row in "WB1".

As well, "Workbook 1" is not constant. I want whatever in WB "Delete" I can use to delete in multiple defined workbooks.

I was able to put together a macro from googling but still doesn't work. Not sure what really went wrong...

Appreciate your help!

Sub DeleteRow()
Dim WrBK1 as Workbook, WrkBK2 as Workbook, wsPlanner as Worksheet, wsDelete as Worksheet
Dim LRPlanner As Long, Cell As Range, MyRange as Range, rgMatch as Range

    Set WrBK1 = Workbooks("Workbook1.xlsb")
    Set WrBK2 = Workbooks("Delete.xlsb")
    Set wsPlanner = WrBK1.Worksheets("Planner")
    Set wsDelete = WrBK2.Worksheets("Delete")
    LRPlanner = wsPlanner.Range("A" & Rows.Count).End(xlUp).Row
    Set MyRange = wsPlanner.Range("A2:A" & LRPlanner)
Application.ScreenUpdating = False    
    For Each Cell in MyRange
    Set rgMatch = wsDelete.Range("D" & Cell.Row)
        If Cell.Value = rgMatch.Value Then
            Cell.EntireRow.Delete
        End If
    Next cell
Application.ScreenUpdating = True
End Sub

 

[mumps]

Are you saying that you want to compare Column A "Delete" to Column D in multiple workbooks? if so, where are these multiple defined workbooks located? Please clarify in detail.

 

[kbui92]

Hi Mumps,

That is correct. I have WB “Delete” on my personal drive. The other multiple defined WBs are on our shared company’s drive.

For example, I have Apple in “Delete” that I want to remove an entire row if Apple is found in WBs “Honey Crisps”, “Lady Smith”, or “Gala.”

In my “Delete”, Apple is on Column A. In other WBs, the data Is usually on Column D.

 

[mumps]

Are the workbooks “Honey Crisps”, “Lady Smith” and “Gala” the only workbooks in that folder on the company’s shared drive? Is the file extension "xlsx"? Will these workbooks be open or does the macro have to open them? Also, please clarify what you mean by:

the data Is usually on Column D

 

[kbui92]

Are the workbooks “Honey Crisps”, “Lady Smith” and “Gala” the only workbooks in that folder on the company’s shared drive? Is the file extension "xlsx"? Will these workbooks be open or does the macro have to open them? Also, please clarify what you mean by:

No, there are other workbooks but I only need to delete in “Honey Crisps”, “Lady Smith” and “Gala”. They all in “xlxb” format.

I’d prefer if I don’t have to open the WBs but not a big deal if I don’t.

And sorry for a bit confusing, the data across 3 WBs all on the same column D. i used “usually” because I wasn’t 10% sure

 

[kbui92]

No, there are other workbooks but I only need to delete in “Honey Crisps”, “Lady Smith” and “Gala”. They all in “xlxb” format.

I’d prefer if I don’t have to open the WBs but not a big deal if I don’t.

And sorry for a bit confusing, the data across 3 WBs all on the same column D. i used “usually” because I wasn’t 10% sure

Jeez, typo -100% sure

 

[mumps]

Is the sheet "Planner" in the each of the 3 workbooks (“Honey Crisps”, “Lady Smith” and “Gala”)?

 

[kbui92]

Is the sheet "Planner" in the each of the 3 workbooks (“Honey Crisps”, “Lady Smith” and “Gala”)?

Yes, it is!

 

[mumps]

Place this macro in the "delete" workbook. Change the folder path (in red) to suit your needs.

Sub DeleteRow()
    Application.ScreenUpdating = False
    Dim desWB As Workbook, desWS As Worksheet, srcWB As Workbook
    Dim wbArr As Variant, i As Long, ii As Long, v1 As Variant, v2 As Variant, dic As Object
    Set desWS = ThisWorkbook.Sheets("Delete")
    v1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    wbArr = Array("Honey Crisps.xlsb", "Lady Smith.xlsb", "Gala.xlsb")
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), Nothing
        End If
    Next i
    For i = LBound(wbArr) To UBound(wbArr)
        Workbooks.Open "C:/test/" & wbArr(i)
        v2 = Sheets("Planner").Range("D2", Sheets("Planner").Range("D" & Rows.Count).End(xlUp)).Value
        For ii = LBound(v2) To UBound(v2)
            If dic.exists(v2(ii, 1)) Then
                Sheets("Planner").Rows(ii + 1).Delete
            End If
        Next ii
        ActiveWorkbook.Close True
    Next i
    Application.ScreenUpdating = True
End Sub

 

[kbui92]

Place this macro in the "delete" workbook. Change the folder path (in red) to suit your needs.

Sub DeleteRow()
    Application.ScreenUpdating = False
    Dim desWB As Workbook, desWS As Worksheet, srcWB As Workbook
    Dim wbArr As Variant, i As Long, ii As Long, v1 As Variant, v2 As Variant, dic As Object
    Set desWS = ThisWorkbook.Sheets("Delete")
    v1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    wbArr = Array("Honey Crisps.xlsb", "Lady Smith.xlsb", "Gala.xlsb")
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1)
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), Nothing
        End If
    Next i
    For i = LBound(wbArr) To UBound(wbArr)
        Workbooks.Open "C:/test/" & wbArr(i)
        v2 = Sheets("Planner").Range("D2", Sheets("Planner").Range("D" & Rows.Count).End(xlUp)).Value
        For ii = LBound(v2) To UBound(v2)
            If dic.exists(v2(ii, 1)) Then
                Sheets("Planner").Rows(ii + 1).Delete
            End If
        Next ii
        ActiveWorkbook.Close True
    Next i
    Application.ScreenUpdating = True
End Sub

Sorry for not getting back to you right away!!

So I copied & F8 to run the code and I run into a few errors. Do I need to set any value for this?

Sub DeleteRow()
    Application.ScreenUpdating = False
    Dim desWB As Workbook, desWS As Worksheet, srcWB As Workbook
    Dim wbArr As Variant, i As Long, ii As Long, v1 As Variant, v2 As Variant, dic As Object
    Set desWS = ThisWorkbook.Sheets("Delete")
    v1 = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp)).Value
    wbArr = Array("Honey Crisps.xlsb", "Lady Smith.xlsb", "Gala.xlsb")
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v1) To UBound(v1) Error 13 Type Mismatch
        If Not dic.exists(v1(i, 1)) Then
            dic.Add v1(i, 1), Nothing
        End If
    Next i So I skipped to this
    For i = LBound(wbArr) To UBound(wbArr)
        Workbooks.Open "C:/test/" & wbArr(i)
        v2 = Sheets("Planner").Range("D2", Sheets("Planner").Range("D" & Rows.Count).End(xlUp)).Value
        For ii = LBound(v2) To UBound(v2)
            If dic.exists(v2(ii, 1)) Then Then I got an error 91 - block variable not set.
                Sheets("Planner").Rows(ii + 1).Delete
            End If
        Next ii
        ActiveWorkbook.Close True
    Next i
    Application.ScreenUpdating = True
End Sub