Loop Through Sheets To Remove Duplicates

[mayoung]

How can I modify this code that loops though each sheet and to delete the row based on duplicates in column 3.
Each page has a table and the table name is always different.

Private Sub RemoveDuplicates()
'
  Application.ScreenUpdating = False

    Dim wsheet As Worksheet
    For Each wsheet In ActiveWorkbook.Worksheets
    If UCase(wsheet.Name) Like "*SHEET*" Then
    Application.DisplayAlerts = False
    wsheet.Range("Table1[#All]").RemoveDuplicates Columns:=3, Header:= _
    xlYes
    Application.DisplayAlerts = True
    End If
    Next
   
  Application.ScreenUpdating = True
     
End Sub

 

[DanteAmor]

Try this:

Private Sub RemoveDuplicates()
  Dim ws As Worksheet, tbl As ListObject
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  For Each ws In ActiveWorkbook.Worksheets
    If UCase(ws.Name) Like "*SHEET*" Then
      For Each tbl In ws.ListObjects
        tbl.DataBodyRange.RemoveDuplicates Columns:=3, Header:=xlYes
      Next
    End If
  Next
  Application.ScreenUpdating = True
End Sub

 

[mayoung]

Try this:

Private Sub RemoveDuplicates()
  Dim ws As Worksheet, tbl As ListObject
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False

  For Each ws In ActiveWorkbook.Worksheets
    If UCase(ws.Name) Like "*SHEET*" Then
      For Each tbl In ws.ListObjects
        tbl.DataBodyRange.RemoveDuplicates Columns:=3, Header:=xlYes
      Next
    End If
  Next
  Application.ScreenUpdating = True
End Sub

Worked Perfectly Thank You so much...

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.