Delete row from 2 sheets in one go if match found

[Harshil Mehta]

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.

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

 

[GWteB]

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.

 

[Harshil Mehta]

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.

 

[Marc L]

Hi,​

​

if each sheet contains many non contiguous rows to delete so link a workbook sample on a files host website like Dropbox …​

 

[Fluff]

How about

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

 

[Harshil Mehta]

How about

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

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

 

[Fluff]

You have not created the dictionary, which is why you are getting the error.

 

[Harshil Mehta]

You have not created the dictionary, which is why you are getting the error.

Thank you. That was really helpful!

 

[Fluff]

You're welcome & thanks for the feedback.