VBA: Match with ID in sheet 1 and delete rows with matching ID in other sheets

[sr1111]

VBA: Match with ID in sheet 1 and delete rows with matching ID in other sheets

Example

SheetX

id	customer name	item	error code
aaa_1@#$Gl
cd.1@#$Gl2
efg1@#3$Gl
1@#5$Gl

Sheet A input

id	customer name	error code1	error code2
1@#5$Gl	any name2		any error
1@#5$Gl	any name1	any error

1@#5$Gl4444	customer name1	error details1	details2
pkkrh_&*$	2	detail2	details2x2

Sheet A output

	customer name	error code1	error code2
1@#5$Gl4444	customer name1	error details1	details2
pkkrh_&*$	2	detail2	details2x2

 

[DanteAmor]

Try this:

Sub DeleteMatch()
  Dim shX As Worksheet, sh As Worksheet
  Dim dic As Object
  Dim c As Range
  Dim lr As Long
  
  Application.ScreenUpdating = False
  
  Set shX = Sheets("SheetX")
  Set dic = CreateObject("Scripting.Dictionary")
  
  For Each c In shX.Range("A2", shX.Range("A" & Rows.Count).End(3))
    If c.Value <> "" Then dic(c.Value) = Empty
  Next
  
  For Each sh In Sheets
    If sh.Name <> shX.Name Then
      lr = sh.Range("A" & Rows.Count).End(3).Row
      sh.Range("A1:A" & lr).AutoFilter 1, dic.keys, xlFilterValues
      sh.AutoFilter.Range.Offset(1).EntireRow.Delete
      sh.ShowAllData
    End If
  Next
  
  Application.ScreenUpdating = True
End Sub

 

[sr1111]

Try this:

Sub DeleteMatch()
  Dim shX As Worksheet, sh As Worksheet
  Dim dic As Object
  Dim c As Range
  Dim lr As Long
 
  Application.ScreenUpdating = False
 
  Set shX = Sheets("SheetX")
  Set dic = CreateObject("Scripting.Dictionary")
 
  For Each c In shX.Range("A2", shX.Range("A" & Rows.Count).End(3))
    If c.Value <> "" Then dic(c.Value) = Empty
  Next
 
  For Each sh In Sheets
    If sh.Name <> shX.Name Then
      lr = sh.Range("A" & Rows.Count).End(3).Row
      sh.Range("A1:A" & lr).AutoFilter 1, dic.keys, xlFilterValues
      sh.AutoFilter.Range.Offset(1).EntireRow.Delete
      sh.ShowAllData
    End If
  Next
 
  Application.ScreenUpdating = True
End Sub

Thank you.
How to Match with ID in sheet 1 and delete rows with non-matching ID in other sheets"

 

[JEC]

Here another approach. Two options given in the code, delete matching or non matching, depending on the formula which you are using.

Sub jec()
 Dim sh, r
 For Each sh In Sheets
    If sh.Name <> Sheets("SheetX").Name Then
      With sh.Cells(1).CurrentRegion
         Set r = .Offset(, .Columns.Count + 1).Range("a1:a2")
'         r(2).Formula = "=isnumber(match(A2,SheetX!A:A,0))"      'delete matching
         r(2).Formula = "=iserror(match(A2,SheetX!A:A,0))"        'delete non matching
         .AdvancedFilter 1, r
         .Offset(1).EntireRow.Delete
         sh.ShowAllData
         r.ClearContents
      End With
    End If
 Next
End Sub