VBA to delete rows if value matched across workbooks

kbui92

New Member
Joined
Mar 4, 2022
Messages
12
Office Version
  1. 365
Platform
  1. Windows
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!

VBA Code:
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
 
I just noticed an error in the original code. Please use the version below:
VBA Code:
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 = UBound(v2) To LBound(v2) Step -1
            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
I tested this code on some dummy workbooks and it worked properly with no errors. In order to test it on your data, could you use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your "delete" sheet and one of the "Planner" sheets. Alternately, you could upload copies of the "delete" file and one of the "apple" files to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here (de-sensitized if necessary).
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
I just noticed an error in the original code. Please use the version below:
VBA Code:
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 = UBound(v2) To LBound(v2) Step -1
            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
I tested this code on some dummy workbooks and it worked properly with no errors. In order to test it on your data, could you use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your "delete" sheet and one of the "Planner" sheets. Alternately, you could upload copies of the "delete" file and one of the "apple" files to a free site such as www.box.com or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here (de-sensitized if necessary).
Weird, I tried and got the same error. May be something with my workbooks??

Here are the files.


XL2BB looks a bit complicated for a simpleton like me LOL.
 
Upvote 0
Try:
VBA Code:
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("FDL HABA CMAP F23.xlsb", "IGA HABA CMAP F23.xlsb", "TF HABA CMAP F23.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 "Y:\1 CATEGORY MERCHANT COMMUNITY BANNERS\GROCERY HABA CM FILES\ASHLEY\!!!!!CMAP & VENDOR PROPOSALS\" & wbArr(i)
        v2 = ActiveWorkbook.Sheets("Planner").Range("D12", ActiveWorkbook.Sheets("Planner").Range("D" & Rows.Count).End(xlUp)).Value
        For ii = UBound(v2) To LBound(v2) Step -1
            If dic.exists(v2(ii, 1)) Then
                Sheets("Planner").Rows(ii + 11).Delete
            End If
        Next ii
        ActiveWorkbook.Close True
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
Try:
VBA Code:
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("FDL HABA CMAP F23.xlsb", "IGA HABA CMAP F23.xlsb", "TF HABA CMAP F23.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 "Y:\1 CATEGORY MERCHANT COMMUNITY BANNERS\GROCERY HABA CM FILES\ASHLEY\!!!!!CMAP & VENDOR PROPOSALS\" & wbArr(i)
        v2 = ActiveWorkbook.Sheets("Planner").Range("D12", ActiveWorkbook.Sheets("Planner").Range("D" & Rows.Count).End(xlUp)).Value
        For ii = UBound(v2) To LBound(v2) Step -1
            If dic.exists(v2(ii, 1)) Then
                Sheets("Planner").Rows(ii + 11).Delete
            End If
        Next ii
        ActiveWorkbook.Close True
    Next i
    Application.ScreenUpdating = True
End Sub
LOL Guess I didn't remove information very well.

Appreciate your help but I still got stuck at the For i = Lbound/Ubound ;(
 
Upvote 0
You had only one value in column A of the delete sheet. Try adding a few more values, at least two or three.
 
Upvote 0
You had only one value in column A of the delete sheet. Try adding a few more values, at least two or three.
Like value for the WBs to compare or just random value?

I have other columns with match formula as a double check.
 
Upvote 0
I copied D12:D16 from Gala and Lady Smith into column A of "Delete". I ran the macro and it worked properly for the Gala file by deleting rows 12 to 16. However, the Lady Smith file caused Excel to hang and I had to use the Task manager to close Excel because it was not responding. There must be something in the Lady Smith file that is causing Excel not to respond but I can't figure out what the problem is. The macro works properly for the Gala file so I see no reason why it shouldn't also work for the Lady Smith file.
 
Upvote 0
I copied D12:D16 from Gala and Lady Smith into column A of "Delete". I ran the macro and it worked properly for the Gala file by deleting rows 12 to 16. However, the Lady Smith file caused Excel to hang and I had to use the Task manager to close Excel because it was not responding. There must be something in the Lady Smith file that is causing Excel not to respond but I can't figure out what the problem is. The macro works properly for the Gala file so I see no reason why it shouldn't also work for the Lady Smith file.
Very weird. I ran the macro and always stuck in the 'Lbound(v1) to Ubound (v1) with the mismatch type....

With the Lady Smith file, I ran it with the "Lbound/Ubound" removed and it ran ok but I believe this is the part where it removes the matched value?
 
Upvote 0
Since the macro worked properly for me using the Gala file you posted, I don't think that the error you are getting is caused by the macro. If it worked properly for the Gala file, it should work properly for all the files as long as the data is organized in exactly the same way in all the files. The error is most likely caused by how your data is organized. I assume that the files you posted are sample files and that your actual files are different. In order to find what is causing the error, I would need you to upload your actual files not sample files.
 
Upvote 0
Since the macro worked properly for me using the Gala file you posted, I don't think that the error you are getting is caused by the macro. If it worked properly for the Gala file, it should work properly for all the files as long as the data is organized in exactly the same way in all the files. The error is most likely caused by how your data is organized. I assume that the files you posted are sample files and that your actual files are different. In order to find what is causing the error, I would need you to upload your actual files not sample files.
Actually, the files I share are the actual files... I just removed data I can't share & changed the titles. That's it...
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,220
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