Finding Duplicate Rows & Highlighting them

[frankjh19701]

I have data in a worksheet that contains both numbers & text.

I want to find a formula or Macro that can search the entire sheet an
ONLY highlight the rows that are duplicated. Not just the first cell
the whole row.

The data goes from Column A to Column M.

I don't want them deleted or moved - only highlighted.

Any/all assistance would be greatly appreciated.

Thank yo

 

[Auric__]

I have data in a worksheet that contains both numbers & text.

I want to find a formula or Macro that can search the entire sheet and
ONLY highlight the rows that are duplicated. Not just the first cell,
the whole row.

The data goes from Column A to Column M.

I don't want them deleted or moved - only highlighted.

This will bold the duplicated rows. Other methods of "highlighting" are
possible, just depends on what you want.

Sub findDupsAndBold()
For L0 = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row - 1
For L1 = L0 + 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
theSame = True
For L2 = 1 To Cells.SpecialCells(xlCellTypeLastCell).Column
If Cells(L0, L2).Value <> Cells(L1, L2).Value Then
theSame = False
Exit For
End If
Next
If theSame Then
Rows(L0).Font.Bold = True
Rows(L1).Font.Bold = True
End If
Next
Next
End Sub

(There are probably better ways to do this, but I already had a similar thing
written.)

 

[frankjh19701]

I just tried it and it worked great!

How would I highlight the rows?

 

[Auric__]

frankjh19701 wrote:
-

I have data in a worksheet that contains both numbers & text.

I want to find a formula or Macro that can search the entire sheet and
ONLY highlight the rows that are duplicated. Not just the first cell,
the whole row.

The data goes from Column A to Column M.

I don't want them deleted or moved - only highlighted.-

This will bold the duplicated rows. Other methods of "highlighting" are
possible, just depends on what you want. [snip code]
(There are probably better ways to do this, but I already had a similar
thing written.)

I just tried it and it worked great!

How would I highlight the rows?

(Please don't top post.)

It depends on what you mean by "highlight". If you want it painted yellow,
as if using a highlighter pen, change this:

Rows(L0).Font.Bold = True
Rows(L1).Font.Bold = True

to this:

Rows(L0).Interior.Color = vbYellow
Rows(L1).Interior.Color = vbYellow

I use bold for my own stuff, but as I said, there are ways and ways.

 

[GS]

A couple of ways...

Option Explicit

Const lColorNdx = 36 '//light yellow

Sub HighlightDupeRows()
Dim lRows&, lCols&, n&, k&, r, r1, r2
With ActiveSheet.UsedRange
lRows = .Rows.Count: lCols = .Columns.Count
End With
For Each r In ActiveSheet.UsedRange.Rows
For n = 1 To lRows - 1
For k = 1 To lCols
r1 = r1 & Cells(r.Row, k).Value
r2 = r2 & Cells(n + 1, k).Value
Next 'k
If r1 = r2 And r.Row <> (n + 1) Then
Rows(r.Row).Interior.ColorIndex = lColorNdx
Rows(n + 1).Interior.ColorIndex = lColorNdx
End If
r1 = "": r2 = ""
Next 'n
Next 'r
End Sub

Sub HighlightDupeRows2()
Dim v1, v2, n&, k&, r&, r1, r2
v1 = ActiveSheet.UsedRange
For r = 1 To UBound(v1) - 1
For n = 2 To UBound(v1)
r1 = "": r2 = ""
For k = 1 To UBound(v1, 2)
r1 = r1 & v1(r, k): r2 = r2 & v1(n, k)
Next 'k
If r1 = r2 And n <> r Then
Rows(n).Interior.ColorIndex = lColorNdx
Rows(r).Interior.ColorIndex = lColorNdx
End If 'r1=r2
Next 'n
Next 'r
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[frankjh19701]

;1614135']A couple of ways...

Option Explicit

Const lColorNdx = 36 '//light yellow

Sub HighlightDupeRows()
Dim lRows&, lCols&, n&, k&, r, r1, r2
With ActiveSheet.UsedRange
lRows = .Rows.Count: lCols = .Columns.Count
End With
For Each r In ActiveSheet.UsedRange.Rows
For n = 1 To lRows - 1
For k = 1 To lCols
r1 = r1 & Cells(r.Row, k).Value
r2 = r2 & Cells(n + 1, k).Value
Next 'k
If r1 = r2 And r.Row <> (n + 1) Then
Rows(r.Row).Interior.ColorIndex = lColorNdx
Rows(n + 1).Interior.ColorIndex = lColorNdx
End If
r1 = "": r2 = ""
Next 'n
Next 'r
End Sub

Sub HighlightDupeRows2()
Dim v1, v2, n&, k&, r&, r1, r2
v1 = ActiveSheet.UsedRange
For r = 1 To UBound(v1) - 1
For n = 2 To UBound(v1)
r1 = "": r2 = ""
For k = 1 To UBound(v1, 2)
r1 = r1 & v1(r, k): r2 = r2 & v1(n, k)
Next 'k
If r1 = r2 And n <> r Then
Rows(n).Interior.ColorIndex = lColorNdx
Rows(r).Interior.ColorIndex = lColorNdx
End If 'r1=r2
Next 'n
Next 'r
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

This worked out great! Thank you

 

[GS]

This worked out great! Thank you!

You are welcome. I appreciate the feedback!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion