Search for Duplicates in Multiple Sheets and Delete if Found.

[Daroh]

Hello, I have a list on sheet1 of peoples names (col C) and a specific identification number (Col G) for each person. This list will be updated daily. Over the coming days, extra tabs will be added with a list of people and specific number. Is it possible for excel to search for duplicates in all the sheets and if a persons name and specific number is found in another sheet to delete the row that the persons name is in from sheet1? Sheet1 is people to be re-booked and the extra tabs/sheets will be days which they are rebooked. Thanks.

 

[JLGWhiz]

Maybe this

Sub t()
Dim sh As Worksheet, fn As Range, c As Range
    For Each c In Sheet1.Range("G2", Cells(Rows.Count, 7).End(xlUp))
        For Each sh In ThisWorkbook.Sheets
            If sh.Name <> Sheet1.Name Then
                Set fn = sh.Range("G:G").Find(c.Value, , xlValues)
                    If Not fn Is Nothing Then
                        c.EntireRow.Delete
                        Exit For
                    End If
            End If
        Next
    Next
End Sub

 

[Fluff]

Another option

Sub Daroh()
   Dim Ws As Worksheet
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Ws In Worksheets
         If Not Ws.Name = "Sheet1" Then
            For Each Cl In Ws.Range("G2", Ws.Range("G" & Rows.Count).End(xlUp))
               .Item(Cl.Value) = Empty
            Next Cl
         End If
      Next Ws
      Sheets("Sheet1").Range("A1:G1").AutoFilter 7, .Keys, xlFilterValues
      Sheets("Sheet1").AutoFilter.Range.Offset(1).EntireRow.Delete
      Sheets("Sheet1").AutoFilterMode = False
   End With
End Sub

 

[Daroh]

Hello, both codes work perfect, thank you. However, would it be possible to make amendment to the code? so that if a persons number is not in sheet1 and is in another sheet that it deletes it from the other sheet? For example, if a persons number is 456, in sheet5 and not in sheet1,it deletes the entire row with the number 456 in sheet5? Thanks.

 

[Fluff]

How about

Sub Daroh()
   Dim Ws As Worksheet, Ws1 As Worksheet
   Dim Cl As Range, Rng As Range
   Dim Dic As Object
   
   Set Ws1 = Sheets("Sheet1")
   Set Dic = CreateObject("Scripting.dictionary")
   
   For Each Cl In Ws1.Range("G2", Ws1.Range("G" & Rows.Count).End(xlUp))
      Dic.Item(Cl.Value) = Empty
   Next Cl

   With CreateObject("scripting.dictionary")
      For Each Ws In Worksheets
         If Not Ws.Name = "Sheet1" Then
            For Each Cl In Ws.Range("G2", Ws.Range("G" & Rows.Count).End(xlUp))
               .Item(Cl.Value) = Empty
               If Not 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
         End If
      Next Ws
      Ws1.Range("A1:G1").AutoFilter 7, .Keys, xlFilterValues
      Ws1.AutoFilter.Range.Offset(1).EntireRow.Delete
      Ws1.AutoFilterMode = False
   End With
End Sub

 

[Daroh]

Hello, the code is perfect. Thank you very much.

 

[Fluff]

Glad we could help & thanks for the feedback