Using vba to delete duplicate in different worksheet marco

[th1nkmaster]

Hi all, I currently have a spreadsheet with a bunch of data over 17 different sheets, I need to create a macro to remove duplicate. The data name is 2016 data, 2015 data,2014 data and so on... The hardest parts need to identify different array (c,d,e,f) not the hold dataset to find the duplicate in 17 sheets.
There may be duplicate values between, 2016 data, 2015 data, 2014 data and so on... if there are two versions of the particular car, one of them is removed entirely, leaving just a single version of the car in the dataset. Also, need to inform the user how many cars have been removed in total.

Any help is appreciated

Thanks

 

[Fluff]

Hi & welcome to the board.
If a car is found on more that sheet, does it matter which one is deleted?
Also, do the values in cols C:F have to all match to be considered a duplicate, or do you mean that col C in one sheet has to match with col F in another?

 

[th1nkmaster]

Thank you for your reply. It doesn't matter which one is deleted. I mean the cols C:F have to all match to be considered a duplicate, I want to make a button to delete duplicate all 17 years at the same time and a message box to show how many data delete in total 17 years. I try to record macro, the macro is
Sub removeduplicate()

' remove duplicate
'


'
Sheets("2016 data").Select
ActiveSheet.Range("$A$1:$V$4511").RemoveDuplicates Columns:=Array(3, 4, 5, 6), _
Header:=xlYes
Sheets("2015 data").Select
ActiveSheet.Range("$A$1:$U$4994").RemoveDuplicates Columns:=Array(3, 4, 5, 6), _
Header:=xlYes
Sheets("2014 data").Select
ActiveSheet.Range("$A$1:$U$3555").RemoveDuplicates Columns:=Array(3, 4, 5, 6), _
Header:=xlYes
Sheets("2013 data").Select
ActiveSheet.Range("$A$1:$U$3965").RemoveDuplicates Columns:=Array(3, 4, 5, 6), _
Header:=xlYes
Sheets("2012 data").Select
ActiveSheet.Range("$A$1:$U$3457").RemoveDuplicates Columns:=Array(3, 4, 5, 6), _
Header:=xlYes
Sheets("2011 data").Select
ActiveSheet.Range("$A$1:$U$2969").RemoveDuplicates Columns:=Array(3, 4, 5, 6), _
Header:=xlYes
......
It can work but the only problem is I don't know how to add a msg box to show how many data have been removed.


Really appreciate your replied.

 

[Fluff]

Ok, the code you've posted will delete the duplicate on each sheet. If a car is found on both the 2015 sheet & the 2016 sheet does one of them need to be deleted, or is it only remove the duplicates on individual sheets?

 

[th1nkmaster]

Only remove the duplicates on individual sheets, but need to show how many data have been removed in total in the msg box.

 

[Fluff]

Ok, how about this

Sub DeleteDuplicatesOnSheets()

   Dim Ws As Worksheet
   Dim Cl As Range
   Dim ValU As String
   Dim Qty As Long
   Dim Rng As Range
   
   For Each Ws In Worksheets
      With CreateObject("scripting.dictionary")
         For Each Cl In Ws.Range("C2", Ws.Range("C" & Rows.Count).End(xlUp))
            ValU = Join(Application.Transpose(Application.Transpose(Cl.Resize(, 4))))
            If Not .exists(ValU) Then
               .Add ValU, Nothing
            Else
               Qty = Qty + 1
               If Rng Is Nothing Then
                  Set Rng = Cl
               Else
                  Set Rng = Union(Rng, Cl)
               End If
            End If
         Next Cl
         If Not Rng Is Nothing Then Rng.EntireRow.Delete
         .RemoveAll
      End With
   Next Ws
   MsgBox Qty & " rows have been deleted"

End Sub

 

[th1nkmaster]

I don't know why the code its not working, "Set Rng = Union(Rng, Cl) " this bit is yellow. There are two sheets . Also, there are two sheets don't need to remove duplicate call "answer and answer two " the first and second worksheet in the workbook.
Thank you for you reply

 

[Fluff]

My fault, forgot to reset the range, try

Sub DeleteDuplicatesOnSheets()

   Dim Ws As Worksheet
   Dim Cl As Range
   Dim ValU As String
   Dim Qty As Long
   Dim Rng As Range
   
   For Each Ws In Worksheets
      If Not Ws.Name = "[COLOR=#ff0000]answer[/COLOR]" And Not Ws.Name = "[COLOR=#ff0000]answer two[/COLOR]" Then
         With CreateObject("scripting.dictionary")
            For Each Cl In Ws.Range("C2", Ws.Range("C" & Rows.Count).End(xlUp))
               ValU = Join(Application.Transpose(Application.Transpose(Cl.Resize(, 4))))
               If Not .exists(ValU) Then
                  .Add ValU, Nothing
               Else
                  Qty = Qty + 1
                  If Rng Is Nothing Then
                     Set Rng = Cl
                  Else
                     Set Rng = Union(Rng, Cl)
                  End If
               End If
            Next Cl
            If Not Rng Is Nothing Then Rng.EntireRow.Delete
            Set Rng = Nothing
            .RemoveAll
         End With
      End With
   Next Ws
   MsgBox Qty & " rows have been deleted"

End Sub

This will also ignore the 2 sheet names in red, check they are spelt correctly.

 

[th1nkmaster]

when I run the macro it said error End with without with...

 

[th1nkmaster]

I modify the code to end if, and it can run. But when I run the macro, excel keep loading and I wait for the response for a really long time still not give me any response. It is something wrong with my laptop? or the macro is too big?