Display a message box if you find duplicate rows based on multiple columns

[Siri Jasthi]

Hi All,

Can anyone help me to write a macro to display a message box if you find duplicates based on multiple columns.

I have an excel with 7 columns and rows should be given dynamically.In that 1,3,5 are unique columns so the combination of those records should not be duplicates , if any record is identical with the combination of 1,3,5 then i should get a message box that there are duplicates in these rows.

Example :

column 1 column2 column 3 column 4 column 5 column 6 column 7
Apple Bat Cat Dog Egg Fan Gun
Ant Ball Can Don Eight Fun Gate
Apple Big Cat Den Egg Fin Gin

From the above Row 1 and Row 3 are duplicates because combination of the columns 1,3,5 are identical.So I should get a message box with message as Row 1 and Row 3 are duplicate rows.

 

[Siri Jasthi]

You keep adding more questions "one extra thing", "One last question", "Last one more thing". Why not ask for everything you want at the beginning

Here you go - with detailed explanations

The formula used
So that you understand what the code is doing place this formula in J8 and copy down

=COUNTIFS(C$8:C8,C8,D$8:D8,D8,E$8:E8,E8,F$8:F8,F8,G$8:G8,G8,H$8:H8,H8,I$8:I8,I8)>1

- the formula returns TRUE for rows being deleted based on all 7 columns being the same
- the formula is counting how many times a row is duplicated up to and including the current row
- the first cell of each range is absolute (using $) , the 2nd cell is relative
- the formula only returns TRUE after the first instance of a duplicated row ( >1 does this)

The formula and my code is based on the code you included in post7

The code
The first cell in each range is made absolute by using variable f (which is given value 8 as in your code)
A variable is used to build the string to be evaluated - this is clearer to read

Sub Test()
    Dim l As Long, f As Long, msg As String, fstr As String
    l = Range("C" & Rows.Count).End(xlUp).Row
    f = 8
    For r = f To l
        fstr = "C" & f & ":C" & r & ",C" & r & ",D" & f & ":D" & r & ",D" & r & ",E" & f & ":E" & r & ",E" & r & ",F" & f & ":F" & r & ",F" & r & ",G" & f & ":G" & r & ",G" & r & ",H" & f & ":H" & r & ",H" & r & ",I" & f & ":I" & r & ",I" & r & ""
        If Evaluate("COUNTIFS(" & fstr & ")") > 1 Then msg = msg & vbCr & r
    Next
    MsgBox msg, vbInformation, "DELETED ROWS"
End Sub

Your code changed
In post7 your code was this
Worksheets("Data").Range("$C$8:$I$" & lastrow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes

In post9 your code is amended to this
Worksheets("Data").Range("$C$8:$I$" & lastrow).RemoveDuplicates Columns:=Array(1, 2, 3, 5, 7), Header:=xlYes

Amend my code to match your different requirement
I suggest you amend the formula in J2 first (and copy down) to make sure that is giving you the correct results
Then amend the string in the code to match

Really Sorry ...i know i made u confused and troubled u a lot .Very Very Sorry but i m very thankful to you for ur helping.


Here everything is working fine but when the duplicate row is deleted for example row 10 is deleted then the data below the row 10 i.e from row 11 is copying into row 10 after the row 10 is deleted.That should not happen the row 10 should be blank.Can you help me.

 

[Yongle]

RemoveDuplicates removes the cells and that is what you told VBA you wanted with

Worksheets("Data").Range("$C$8:$I$" & lastrow).RemoveDuplicates Columns:=Array(1, 2, 3, 5, 7), Header:=xlYes

Remove that line from your code

Try ClearContents
Replace

        If Evaluate("COUNTIFS(" & fstr & ")") > 1 Then msg = msg & vbCr &

With

        If Evaluate("COUNTIFS(" & fstr & ")") > 1 Then
            msg = msg & vbCr & r
            Range("C" & r).Resize(, 7).ClearContents
        End If

If only some cells are to be cleared, list the appropriate cells

Range("C" & r).ClearContents
Range("D" & r).ClearContents
etc

 

[Siri Jasthi]

Hi Thank You so much for your help.

Last one more thing i need please help me.

How to get the message as below in the message box

There are few duplicates found in the 10,11 rows,please correct and execute.

Hi ,

The macro is working if there are duplicates , if after removing duplicates also that message box is cumng .Could you please help me.

 

[Yongle]

Try amending message line to

If msg <> "" Then MsgBox msg, vbInformation, "DUPLICATE ROWS"

 

[Siri Jasthi]

Try amending message line to

If msg <> "" Then MsgBox msg, vbInformation, "DUPLICATE ROWS"

Hi In our excel after entering data and few validations like duplicates,null entries we create a sql .

My macro :

For r = 10 To l

If Evaluate("COUNTIFS(C:C,C" & r & ",D:D,D" & r & ",E:E,E" & r & ",G:G,G" & r & ",I:I,I" & r & ")") > 1 Then msg = msg & vbCr & r
Next

If msg <> "" Then MsgBox msg, vbInformation, "There are duplicates found in the below rows,please correct and execute"

Exit Sub


Here we gave exit sub that means if any duplicates are there it will not allow to create sql file . but here
If msg <> "" Then MsgBox msg, vbInformation, "DUPLICATE ROWS"
this code is working if there are no duplicates but it is not creating sql file because of exit sub can u please help me where to keep exit sub .

 

[Yongle]

Please post your ALL of your code enclosed in code tags
- click Reply To Post
- click on # icon above post window to get the code tags
- [ CODE ][ /CODE ]
- paste code inside the tags
- [ CODE ] your code goes here [ /CODE ]

When you click reply it will then look like ths

[COLOR=#008080][I]your code[/I][/COLOR]