How to highlight duplicate ROWS in excel

I want to highlight duplicate rows in excel to be highlighted

Code should check for entire row matching

Quote:

---

Originally Posted by v_gyku

I want to highlight duplicate rows in excel to be highlighted

Code should check for entire row matching

---

do you wish to highlight all duplicated rows in the sheet or just those that have been selected?

Welcome to VBAX! :hi:

I've moved your thread to the Excel Forum. :whistle:

Check out my addin at http://members.iinet.net.au/~brettdj/

Quote:

---

Originally Posted by brettdj

Check out my addin at http://members.iinet.net.au/~brettdj/

---

Used it some time ago!

Nice peace of work Dave! :thumb

HI sir,

I visited the link u have given
I got that duplicate rows example.
But i want to wri te the code for it, Can u give me the code..
It is asking for password when i am trying to open vbaproject (duplicatemaster.xla)
please can u help me

I want that example where in it is hilighting the entire row which is same as other row.


ENTIRE ROW SHOULD BE SAME.

see http://www.vbaexpress.com/forum/showthread.php?t=325

my last post should give you enough to work from.

Note that you need to add a reference to the Microsoft Scripting Runtime via Tools - References in the VBe

sir

ur code is highlighting only one instance of matching rows in a sheet.
How will i highlight all the instances matching.
And i dont want that comarison with other sheets.

I am givin u ur code can u modify it?

Code:

---

Option Explicit
 
Sub HighDupes()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Row1 As Range, Row2 As Range
Dim Col1 As Range, Col2 As Range
Dim NewStr1 As String, Newstr2 As String
'Needs reference to Microsoft Scripting Runtime
Dim MyDic As Dictionary
Set MyDic = New Dictionary
Set ws1 = ActiveWorkbook.Sheets(1)
Set ws2 = ActiveWorkbook.Sheets(2)
Application.ScreenUpdating = False
For Each Row1 In ws1.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(ws1.Rows(Row1.Row)) > 0 Then
NewStr1 = "Sheet1"
For Each Col1 In ws1.UsedRange.Columns
NewStr1 = NewStr1 & "|" & ws1.Cells(Row1.Row, Col1.Column)
Next
If MyDic.exists(NewStr1) Then
'Colour intra sheet duplicates in sheet 1 as blue
ws1.Rows(Row1.Row).Interior.Color = vbBlue
Else
MyDic.Add NewStr1, Row1.Row
End If
End If
Next
For Each Row2 In ws2.UsedRange.Rows
'If rows are blank then skip
If Application.CountA(ws2.Rows(Row2.Row)) > 0 Then
Newstr2 = "Sheet1"
' to match existing keys in Sheet1
For Each Col2 In ws2.UsedRange.Columns
Newstr2 = Newstr2 & "|" & ws2.Cells(Row2.Row, Col2.Column)
Next
If MyDic.exists(Newstr2) Then
'Colour inter sheet duplicates in sheet 2 as red
ws2.Rows(Row2.Row).Interior.Color = vbRed
Else
'This row and the Else test is redundant really if the user isn't looking for matches
'within Sheet2.
MyDic.Add Newstr2, Row2.Row
End If
End If
Next
Application.ScreenUpdating = True
Set MyDic = Nothing
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

---

it does highlights all row matches

I have added one new line below to highlight the first occurence of a row that has dupes. I've culled the dup work on the second sheet

Code:

---

Option Explicit

Sub HighDupes()
    Dim ws1 As Worksheet
    Dim Row1 As Range
    Dim Col1 As Range
    Dim NewStr1 As String
    'Needs reference to Microsoft Scripting Runtime
    Dim MyDic As Dictionary
    Set MyDic = New Dictionary
    Set ws1 = ActiveWorkbook.Sheets(1)
    Application.ScreenUpdating = False
    For Each Row1 In ws1.UsedRange.Rows
        'If rows are blank then skip
        If Application.CountA(ws1.Rows(Row1.Row)) > 0 Then
            NewStr1 = "Sheet1"
            For Each Col1 In ws1.UsedRange.Columns
                NewStr1 = NewStr1 & "||" & ws1.Cells(Row1.Row, Col1.Column)
            Next
            If MyDic.exists(NewStr1) Then
                'Colour intra sheet duplicates in sheet 1 as blue
                ws1.Rows(Row1.Row).Interior.Color = vbBlue
                ws1.Rows(MyDic(NewStr1)).Interior.Color = vbRed
            Else
                MyDic.Add NewStr1, Row1.Row
            End If
        End If
    Next
    Application.ScreenUpdating = True
    Set MyDic = Nothing
    Set ws1 = Nothing
End Sub

---

Thank u very much sir!

THank u sir, My problem is solved.
Thank u for being with me.