How to remove duplicate and create new worksheet of duplicate records.

Nitesh Khot · Oct 17, 2015

Hi,

How to delete red highligted value from pivot table of below image & create worksheet of duplicate value using VBA macro.

PIVOT TABLE :-

Thanks in Advance..
Nikh

Nitesh Khot · Oct 18, 2015

Hi..Any idea about how to write macro.

Nebu · Oct 19, 2015

Hi:

I do not think it is possible to delete the data directly from pivot table. The only way is to delete it from base data. I would suggest to use access queries to identify duplicates, it is easy and you will get a separate table with all the duplicate records. Otherwise you will have to write a macro or flag the duplicates using formulas and take it into a new tab.

Thanks

Nitesh Khot · Oct 20, 2015

Hi..Thanks for reply....

But how to write macro to check duplicity or How to use access query.....

Deepak · Oct 20, 2015

Can we have sample database.

Nitesh Khot · Oct 20, 2015

Hi...Please find attachment....

i want to remove and create new worksheet of highligted data in yellow color (PIVOt Table)

Deepak · Oct 20, 2015

Check this.

Code:

Sub copy()
Application.ScreenUpdating = False
[e1] = "count"
[e2:e15] = "=COUNTIF($C$2:$C$15,C2)=1"
[e2:e15].Value = [e2:e15].Value
Sheet1.Range("$A$1").CurrentRegion.AutoFilter Field:=5, Criteria1:="FALSE"
Sheet1.AutoFilter.Range.copy
Sheet2.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheet2.[e1:e15] = ""
Sheet1.AutoFilterMode = False
Sheet1.[e1:e15] = ""
Application.ScreenUpdating = True
End Sub

If you like then we can make it dynamic.

Nitesh Khot · Oct 20, 2015

Hi Deepak,

It absolutely right and working what i am thinking.
But,
How to check one value is assigned to another two or more.
i.e. in my worksheet MPIN - 19879 is mapped to two URN but vice versa if you change PIVOT table as attached in file that one URN in mapped to two MPIN then I want to remove those records and move those records into newsheet.

is this possible...

Deepak · Oct 20, 2015

You mean to say that if a mpin is assigned to more than 1 urn then remove it from the list & make seprate sheet of them.

Nitesh Khot · Oct 20, 2015

Yes....

My query is ...one URN with One MPIN or vice versa.....

But in our datadump there may be lots of duplicity in combination of ONE URN = ONE MPIN..but we want remove & create sheet only ONE URN = Multiple MPIN or ONE MPIN = Multiple URN. and then rest unique records are keep in the same sheet.

Deepak · Oct 21, 2015

Check it.

Code:

Sub copy1()
Dim r As Integer, c As Integer, str As String, varF As Variant

Application.ScreenUpdating = False
Sheet2.Range("A1").CurrentRegion.Cells.Clear

With Sheet1
    If .AutoFilterMode = True Then .AutoFilterMode = False
   
    With .[$A$1].CurrentRegion
        r = .Rows.Count: c = .Columns.Count
            .Offset(, c).Resize(1, 1) = "count"
    End With
   
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)) = "=AND(COUNTIF($C$2:$C$15,C2)=1,COUNTIF($B$2:$B$15,B2)=1)"
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value = .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value

    .Range("$A$1").CurrentRegion.AutoFilter Field:=c + 1, Criteria1:="FALSE"
        .AutoFilter.Range.Resize(, c).copy
            Sheet2.Range("A1").PasteSpecial xlPasteValues
            .AutoFilterMode = False
                Application.CutCopyMode = False
    .Range(.Cells(1, c + 1), .Cells(r, c + 1)) = ""

str = "=TRANSPOSE(IF(((COUNTIF($C$2:$C$" & r & ",$C$2:$C$" & r & ")=1)*COUNTIF($B$2:$B$" & _
    r & ",$B$2:$B$" & r & ")=1),FALSE,ADDRESS(ROW($B$2:$B$" & r & "),2)))"
   
varF = Join(Filter(Evaluate(str), False, False), ",")

If varF <> "" Then .Range(varF).EntireRow.Delete

End With

Application.ScreenUpdating = True
End Sub

Nitesh Khot · Oct 21, 2015

Hi Deepak,

Salute to you..../\

This was perfect I am looking.....Thank you so much....

Please, can you add comments in above code for better understanding for me.

Thanks a lot...

Deepak · Oct 21, 2015

here it..

Code:

Sub copy1()
Dim r As Integer, c As Integer, str As String, varF As Variant

Application.ScreenUpdating = False
'clear data from sheet2
Sheet2.Range("A1").CurrentRegion.Cells.Clear

With Sheet1
'check & remove filtermode
    If .AutoFilterMode = True Then .AutoFilterMode = False
   
    With .[$A$1].CurrentRegion
    'get rows & columns count of data range
        r = .Rows.Count: c = .Columns.Count
            'add header for helper column
            .Offset(, c).Resize(1, 1) = "count"
    End With
   
   'formula for helper column
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)) = "=AND(COUNTIF($C$2:$C$15,C2)=1,COUNTIF($B$2:$B$15,B2)=1)"
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value = .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value

'filter range with helper column
    .Range("$A$1").CurrentRegion.AutoFilter Field:=c + 1, Criteria1:="FALSE"
    'copy filtered range
        .AutoFilter.Range.Resize(, c).copy
        'paste the same in sheet2
            Sheet2.Range("A1").PasteSpecial xlPasteValues
        'remove autofilter
            .AutoFilterMode = False
            'remove copy area
                Application.CutCopyMode = False
    'remove helper column
    .Range(.Cells(1, c + 1), .Cells(r, c + 1)) = ""

'make a array of data like as used in helper column
str = "=TRANSPOSE(IF(((COUNTIF($C$2:$C$" & r & ",$C$2:$C$" & r & ")=1)*COUNTIF($B$2:$B$" & _
    r & ",$B$2:$B$" & r & ")=1),FALSE,ADDRESS(ROW($B$2:$B$" & r & "),2)))"
   
'evaluate formual & remove false
varF = Join(Filter(Evaluate(str), False, False), ",")

'check & delete the said rows
If varF <> "" Then .Range(varF).EntireRow.Delete

End With

Application.ScreenUpdating = True
End Sub

Deepak · Oct 21, 2015

here it..

Code:

Sub copy1()
Dim r As Integer, c As Integer, str As String, varF As Variant

Application.ScreenUpdating = False
'clear data from sheet2
Sheet2.Range("A1").CurrentRegion.Cells.Clear

With Sheet1
'check & remove filtermode
    If .AutoFilterMode = True Then .AutoFilterMode = False
   
    With .[$A$1].CurrentRegion
    'get rows & columns count of data range
        r = .Rows.Count: c = .Columns.Count
            'add header for helper column
            .Offset(, c).Resize(1, 1) = "count"
    End With
   
   'formula for helper column
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)) = "=AND(COUNTIF($C$2:$C$15,C2)=1,COUNTIF($B$2:$B$15,B2)=1)"
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value = .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value

'filter range with helper column
    .Range("$A$1").CurrentRegion.AutoFilter Field:=c + 1, Criteria1:="FALSE"
    'copy filtered range
        .AutoFilter.Range.Resize(, c).copy
        'paste the same in sheet2
            Sheet2.Range("A1").PasteSpecial xlPasteValues
        'remove autofilter
            .AutoFilterMode = False
            'remove copy area
                Application.CutCopyMode = False
    'remove helper column
    .Range(.Cells(1, c + 1), .Cells(r, c + 1)) = ""

'make a array of data like as used in helper column
str = "=TRANSPOSE(IF(((COUNTIF($C$2:$C$" & r & ",$C$2:$C$" & r & ")=1)*COUNTIF($B$2:$B$" & _
    r & ",$B$2:$B$" & r & ")=1),FALSE,ADDRESS(ROW($B$2:$B$" & r & "),2)))"
   
'evaluate formual & remove false
varF = Join(Filter(Evaluate(str), False, False), ",")

'check & delete the said rows
If varF <> "" Then .Range(varF).EntireRow.Delete

End With

Application.ScreenUpdating = True
End Sub

Nitesh Khot · Oct 22, 2015

Thanks deepak....So nice ........it is possible to check another two column with same condition....

Also I i have made some changes in this code but getting error in "
If varF <> "" Then .Range(varF).EntireRow.Delete".

can you brief about "varF = Join(Filter(Evaluate(str), False, False), ",")"

Code:

With Sheet1
    If .AutoFilterMode = True Then .AutoFilterMode = False
   
    With .[$A$1].CurrentRegion
        r = .Rows.Count: c = .Columns.Count
            .Offset(, c).Resize(1, 1) = "count"
    End With
   
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)) = "=AND(COUNTIF($H$2:$H$691,H2)=1,COUNTIF($G$2:$G$691,G2)=1)"
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value = .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value

    .Range("$A$1").CurrentRegion.AutoFilter Field:=c + 1, Criteria1:="FALSE"
        .AutoFilter.Range.Resize(, c).Copy
            Sheet2.Range("A1").PasteSpecial xlPasteValues
            .AutoFilterMode = False
                Application.CutCopyMode = False
    .Range(.Cells(1, c + 1), .Cells(r, c + 1)) = ""

str = "=TRANSPOSE(IF(((COUNTIF($H$2:$H$" & r & ",$H$2:$H$" & r & ")=1)*COUNTIF($G$2:$G$" & _
    r & ",$G$2:$G$" & r & ")=1),FALSE,ADDRESS(ROW($H$2:$H$" & r & "),2)))"
   
varF = Join(Filter(Evaluate(str), False, False), ",")

If varF <> "" Then .Range(varF).EntireRow.Delete

End With

Application.ScreenUpdating = True
End Sub

Deepak · Oct 22, 2015

VBA Evaluate function is likely to be used due to it robust power.

To evaluate we must have a set of things, here we will evaluate to get array of range which needs to be deleted.

Copy the below formula to excel > press f9 & check what you got there.

=TRANSPOSE(IF(((COUNTIF($C$2:$C$15,$C$2:$C$15)=1)*COUNTIF($B$2:$B$15,$B$2:$B$15)=1),FALSE,ADDRESS(ROW($B$2:$B$15),2)))

You will get a array of range as below.

{"$B$2","$B$3","$B$4","$B$5","$B$6","$B$7","$B$8","$B$9",FALSE,FALSE,"$B$12","$B$13","$B$14",FALSE}

Coming back to VBA.
str holding the same formula just edited for dynamic rows.

str = "=TRANSPOSE(IF(((COUNTIF($H$2:$H$" & r & ",$H$2:$H$" & r & ")=1)*COUNTIF($G$2:$G$" & _
r & ",$G$2:$G$" & r & ")=1),FALSE,ADDRESS(ROW($H$2:$H$" & r & "),2)))"

Now, just like F9 in excel we will first evaluate the formula so it will produce..

Evaluate(str) = like as same red colored array as above

Now, Filter it to remove false so use vba filter fn.

filter(array,"which array element to filter",exclude/or not the same element)

So, here we have the array, False to filter & false to be remove too.

& join together them after filter
Join(Filter(Evaluate(str), False, False), ",")={"$B$2","$B$3","$B$4","$B$5","$B$6","$B$7","$B$8","$B$9","$B$12","$B$13","$B$14"}

Now convert these array of strings to range.

Range(varF)

& delete the entire row as well.

Range(varF).EntireRow.Delete

Your next reply = What to check in others col.

Nitesh Khot · Oct 22, 2015

Thanks for reply....

I am getting error in below code

If varF <> "" Then .Range(varF).EntireRow.Delete
Error : Method 'Range' of object'_Worksheet' failed

> It is possible to check whether one MPIN = One URN or vice versa....If in my database I have lots duplicate combinations of one MPIN = One URN.. I want to remove only those MPIN & URN who is assigned to more that one URN / MPIN.

For Eg. MPIN 19567 is assigned to URN 3004567 and in my database i have lots of entries of this MPIN & URN combination ..so i want to keep this records but another MPIN - 19568 is assigned to URN 3004568 and URN 3004569 with lots of same combination in database...so i want to remove thos records who i have multiple combinations.

I have attached sheet for better expln. Please check remarks column...for better understanding

Deepak · Oct 22, 2015

Slightly modified the code!

Code:

Option Explicit

Sub copy2()
Dim r As Integer, c As Integer, str As String, varF As Variant

Application.ScreenUpdating = False
'clear data from sheet2
Sheet2.Range("A1").CurrentRegion.Cells.Clear

With Sheet1
'check & remove filtermode
   If .AutoFilterMode = True Then .AutoFilterMode = False
   
    With .[$A$1].CurrentRegion
    'get rows & columns count of data range
       r = .Rows.Count: c = .Columns.Count
            'add header for helper column
           .Offset(, c).Resize(1, 1) = "count"
    End With
   
   'formula for helper column
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)) = "=AND(COUNTIF($C$2:$C$" & r & ",C2)=1,COUNTIF($B$2:$B$" & r & ",B2)=1)"
    .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value = .Range(.Cells(2, c + 1), .Cells(r, c + 1)).Value

'filter range with helper column
.Range("$A$1").CurrentRegion.AutoFilter Field:=c + 1, Criteria1:="FALSE"
     'copy filtered range
    .AutoFilter.Range.Resize(, c).Copy
         'paste the same in sheet2
        Sheet2.Range("A1").PasteSpecial xlPasteValues
            ' re filter
            .Range("$A$1").CurrentRegion.AutoFilter Field:=c + 1, Criteria1:="TRUE"
                'copy filtered range
                .AutoFilter.Range.Resize(, c).Copy
                     'paste the same as temp
                    Sheet2.Cells(1, c + 2).PasteSpecial xlPasteValues
                .AutoFilterMode = False
            .Range("A1").CurrentRegion.Cells.Clear
        Sheet2.Cells(1, c + 2).CurrentRegion.Copy
    .Range("A1").PasteSpecial xlPasteAll
Sheet2.Cells(1, c + 2).CurrentRegion.Cells.Clear

End With

Application.ScreenUpdating = True
End Sub

Nitesh Khot · Oct 22, 2015

Thanks .....Deepak,

This is working nice with huge data.

It is possible to keep duplicate data with conditions ...ie.one URN = One MPIN.

for e.g below records are duplicate in my database and above code remove this data due to condition meet false....It is possible to keep those duplicate records ,

records...
C_44244 44244 65516 Single MPIN = Single = Urn or viceversa
C_44244 44244 65516 Single MPIN = Single = Urn or viceversa

Deepak · Oct 22, 2015

Neither it's duplicated on uploaded file nor removed by the code so far!!

Nitesh Khot · Oct 22, 2015

Thanks for reply...

yes the uploaded file doesnt having duplicate data but suppose i have duplicate with same combination ie.One MPIN = One URN and don;t want to remove that data ...I want to remove data who have One URN=Multiple MPIN or One MPIN = Multiple URN.

I want to remove picture 1 data because One URN = Multiple MPIN and picture 2 I want to keep duplicate data but combination is same as ONE URN = ONE MPIN.

1)

2)

Is This Possible...for this condition...

Deepak · Oct 22, 2015

Check this.

I have also changed the approach to advance filter.

Code:

Option Explicit

Sub copy3()
Application.ScreenUpdating = False
With Sheets("Sheet1")
    .[A1].Name = "destBack":    Sheets("Sheet2").[A1].Name = "des"
    Sheet2.Range("A1").CurrentRegion.Cells.Clear

'check & remove filtermode
  If .AutoFilterMode = True Then .AutoFilterMode = False
    With .[$A$1].CurrentRegion
        .Resize(, 1).Name = "fcol"
       
        'formula for helper column
        'IF(AND(COUNTIF($C$2:$C$698,$C2)=1,COUNTIF($B$2:$B$698,$B2)=1),TRUE,COUNTIF($B$2:$B$698,B2)=COUNTIF($C$2:$C$698,C2))
            [fcol].Offset(, .Columns.Count) = _
            "=if(row()=1,""dupe"",if(AND(COUNTIF(" & [fcol].Offset(, 2).Address & ",C1)=1,COUNTIF(" & _
            [fcol].Offset(, 1).Address & ",B1)=1),TRUE,COUNTIF(" & [fcol].Offset(, 1).Address & ",B1)=COUNTIF(" & [fcol].Offset(, 2).Address & ",C1)))"
           
            'convert to values
            [fcol].Offset(, .Columns.Count).Value = [fcol].Offset(, .Columns.Count).Value
                           
            'criteria for advance filter
            .Resize(2, 1).Offset(, 100) = Application.Transpose(Array("dupe", "FALSE"))
            .Resize(2, 1).Offset(, 100).Name = "cri" 'set a named range for advance filter
    End With
                   
    With .[$A$1].CurrentRegion
        'advance filter for false values
        .AdvancedFilter xlFilterCopy, [cri], [des], False
                   
            [cri] = Application.Transpose(Array("dupe", "TRUE")) 'change criteria for advance filter
            ' re advance filter for true values
            .AdvancedFilter xlFilterCopy, [cri], [des].Offset(, 100), False
               
        .Cells.Clear 'clear data from sheet1
       
        'paste back data true values by advance filter
        [des].Offset(, 100).CurrentRegion.AdvancedFilter xlFilterCopy, [cri], [destBack], False
   
        'clear data from temp cells for true values
        [des].Offset(, 100).CurrentRegion.Cells.Clear
        [cri] = ""
        .Resize(, 1).Offset(, .Columns.Count - 1) = ""
        Sheet2.Range(.Resize(, 1).Offset(, .Columns.Count - 1).Address) = ""
    End With
End With

Application.ScreenUpdating = True
End Sub

How to remove duplicate and create new worksheet of duplicate records.

Member

Member

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja