PDA

View Full Version : [SOLVED] How to highlight duplicate ROWS in excel



v_gyku
09-02-2005, 11:22 PM
I want to highlight duplicate rows in excel to be highlighted

Code should check for entire row matching

MWE
09-03-2005, 07:06 AM
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?

MOS MASTER
09-03-2005, 03:56 PM
Welcome to VBAX! :hi:

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

brettdj
09-04-2005, 04:06 AM
Check out my addin at http://members.iinet.net.au/~brettdj/

MOS MASTER
09-04-2005, 04:09 AM
Check out my addin at http://members.iinet.net.au/~brettdj/

Used it some time ago!

Nice peace of work Dave! :thumb

v_gyku
09-04-2005, 09:33 PM
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.

brettdj
09-04-2005, 09:56 PM
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

v_gyku
09-04-2005, 11:02 PM
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?


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

brettdj
09-04-2005, 11:26 PM
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



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

v_gyku
09-05-2005, 12:03 AM
Thank u very much sir!

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