Delete row from 2 sheets in one go if match found

Harshil Mehta

Board Regular
Joined
May 14, 2020
Messages
85
Office Version
  1. 2013
Platform
  1. Windows
Hi, I am trying to delete the entire row from 2 sheets in one go if it finds a match from another sheet.

The below code shows an error and highlights UNION. Got no idea how to fix this.


VBA Code:
Sub custom_Remove_Entities_NewTemp()

Dim Cl As Range, Rng As Range
Dim v1, v2, v3(), i, j, k, r, c, nr As Long
Dim Ary As Variant, Nary As Variant
Dim Dic As Object
Dim colSheets As Collection
Set colSheets = New Collection

    
    colSheets.Add Worksheets("Old.Temp")
    colSheets.Add Worksheets("New.Temp")



  For Each Worksheet In colSheets
   
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Definition.Temp")
    
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Cl.Value
        Next Cl
    End With
    
  
        For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
            If Dic.Exists(Cl.Value) Then
               If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
               
            End If
        Next Cl
  
    If Not Rng Is Nothing Then Rng.EntireRow.Delete


Next

Set colSheets = Nothing
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
The number of passes of your loop is determined by the number of items in the collection. In this case two references, each pointing to another sheet. The action that takes place, deleting some rows, only affects the Difinition.Temp worksheet. The first pass of the loop is successful. The second doesn't, because there's nothing left to delete, so the Range object in the variable Rng is "nothing" at some point, throwing the error.

Because it's not clear to me which worksheet should be the reference sheet (within the comparisson) and from which worksheets the rows should be removed, I don't have an alternative code for you yet.
 
Upvote 0
The number of passes of your loop is determined by the number of items in the collection. In this case two references, each pointing to another sheet. The action that takes place, deleting some rows, only affects the Difinition.Temp worksheet. The first pass of the loop is successful. The second doesn't, because there's nothing left to delete, so the Range object in the variable Rng is "nothing" at some point, throwing the error.

Because it's not clear to me which worksheet should be the reference sheet (within the comparisson) and from which worksheets the rows should be removed, I don't have an alternative code for you yet.
I have data in Definition.Temp Sheet which I want to match it to the data present in Old.Temp and New.Temp. If match is found then delete the entire row from Old.Temp and New.Temp in one go.
 
Upvote 0
Hi,​
if each sheet contains many non contiguous rows to delete so link a workbook sample on a files host website like Dropbox …​
 
Upvote 0
How about
VBA Code:
Sub custom_Remove_Entities_NewTemp()

Dim Cl As Range, Rng As Range
Dim Dic As Object
Dim colSheets As Collection
Set colSheets = New Collection
Dim Ws As Worksheet
   
    colSheets.Add Worksheets("Old.Temp")
    colSheets.Add Worksheets("New.Temp")

    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Definition.Temp")
   
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Cl.Value
        Next Cl
    End With


  For Each Ws In colSheets
 
        For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If Dic.Exists(Cl.Value) Then
               If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
              
            End If
        Next Cl
 
    If Not Rng Is Nothing Then Rng.EntireRow.Delete
    Set Rng=Nothing

   Next

Set colSheets = Nothing
End Sub
 
Upvote 0
Solution
How about
VBA Code:
Sub custom_Remove_Entities_NewTemp()

Dim Cl As Range, Rng As Range
Dim Dic As Object
Dim colSheets As Collection
Set colSheets = New Collection
Dim Ws As Worksheet
  
    colSheets.Add Worksheets("Old.Temp")
    colSheets.Add Worksheets("New.Temp")

    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Definition.Temp")
  
        For Each Cl In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            Dic(Cl.Value) = Cl.Value
        Next Cl
    End With


  For Each Ws In colSheets
 
        For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If Dic.Exists(Cl.Value) Then
               If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
             
            End If
        Next Cl
 
    If Not Rng Is Nothing Then Rng.EntireRow.Delete
    Set Rng=Nothing

   Next

Set colSheets = Nothing
End Sub
Hey Fluff, this works great but when I try to integrated your version of code with rest of my code then it shows an error. Could you help me understand what is going wrong? My set of code simply copies data from Definition Sheet if the cell value in Column A is custom remove and pastes it into Definition.Temp Sheet
VBA Code:
Sub custom_Remove_Entities_NewTemp()

Dim Cl As Range, Rng As Range
Dim v1, v2, v3(), i, j, k, r, c, nr As Long
Dim Ary As Variant, Nary As Variant
Dim Dic As Object
Dim colSheets As Collection
Set colSheets = New Collection

    
    colSheets.Add Worksheets("Old.Temp")
    colSheets.Add Worksheets("New.Temp")




With Sheets("Definition.Temp")
    .Range("A2:R100000").Clear
End With



With Sheets("Definition")
'c = .Cells.Find("*", , , , xlByColumns, xlPrevious, , , False).Column
 c = 11
      Ary = .Range("A6", .Range("A" & Rows.Count).End(xlUp)).Resize(, c).Value2
End With
   ReDim Nary(1 To UBound(Ary), 1 To c - 1)
   For r = 1 To UBound(Ary)
      If LCase(Ary(r, 1)) = "custom remove" Then
         nr = nr + 1
         For c = 2 To UBound(Ary, 2)
            Nary(nr, c - 1) = Ary(r, c)
         Next c
      End If
   Next r

With Sheets("Definition.Temp").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, UBound(Nary, 2))
        .NumberFormat = "@"    'Text format
        .Value = Nary
    End With

With Sheets("Definition.Temp").Cells
     .NumberFormat = "General"
End With


  
'Delete removed entities from Old.Temp Sheet
  
For Each Ws In colSheets
 
        For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
            If Dic.Exists(Cl.Value) Then
               If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
              
            End If
        Next Cl
 
    If Not Rng Is Nothing Then Rng.EntireRow.Delete
    Set Rng = Nothing

   Next

Set colSheets = Nothing
End Sub
 
Upvote 0
You have not created the dictionary, which is why you are getting the error.
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,561
Messages
6,114,317
Members
448,564
Latest member
ED38

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