Mark duplictes in each row

[bandaanders]

HI,

I would like to have a marco that - after selecting a range (as usual via leftclicking and dragging) - marks all duplicates for each row individually (only the duplicates in each row are interesting) by filling the cell with a color.
It seems, I can't attach files, sorry

TIA!

 

[salim hasan]

try this code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


Set Myrange = Selection
Myrange.ClearFormats
For Each cel In Myrange
x = Application.CountIf(Myrange, cel)
If x > 1 Then cel.Interior.ColorIndex = 6
Next


End Sub

 

[bandaanders]

at least I managed to insert this:

[TABLE="width: 400"]
<colgroup> </colgroup><tbody>[TR]
[TD="class: xl65, width: 80"]Albert[/TD]
[TD="class: xl65, width: 80"]Albert[/TD]
[TD="class: xl65, width: 80"]5[/TD]
[TD="class: xl65, width: 80"]Albert_Max[/TD]
[TD="class: xl65, width: 80"]8[/TD]
[/TR]
[TR]
[TD="class: xl65"]6[/TD]
[TD="class: xl65"]7[/TD]
[TD="class: xl65"]57[/TD]
[TD="class: xl65"]7[/TD]
[TD="class: xl65"]Max[/TD]
[/TR]
[TR]
[TD="class: xl65"]Max[/TD]
[TD="class: xl65"]g5[/TD]
[TD="class: xl65"]Max[/TD]
[TD="class: xl65"]G5[/TD]
[TD="class: xl65"]8[/TD]
[/TR]
[TR]
[TD="class: xl65"]viii[/TD]
[TD="class: xl65"][/TD]
[TD="class: xl65"]viii[/TD]
[TD="class: xl65"]viii[/TD]
[TD="class: xl65"]8[/TD]
[/TR]
</tbody>[/TABLE]

What is bold should be marked by formating the cell in some color.

TIA!

 

[bandaanders]

try this code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)


Set Myrange = Selection
Myrange.ClearFormats
For Each cel In Myrange
x = Application.CountIf(Myrange, cel)
If x > 1 Then cel.Interior.ColorIndex = 6
Next


End Sub

Thank you for your answer!
Sorry, I am just a noob.
How does this work. I copied your code in a module, but it does not appear as a macro.

 

[bandaanders]

o.k. I managed to make your code work, but I dont think it is working correctly, because the code highlights the last row also.
What I would like to have, is a code that doesnt seach a whole range, but does it individually for each row.

TIA!

 

[salim hasan]

send your Email to attache the file
because no way to attache it with this forum

 

[hiker95]

send your Email to attache the file
because no way to attache it with this forum

salim hasan, bandaanders,

The following is a free site:

You can upload your workbook to (the BLUE link-->) Box Net ,
sensitive data changed
mark the workbook for sharing
and provide us with a link to your workbook.

 

[bandaanders]

hi all,
I hope, I have figured out this box.net-thing too. Here is a link:

https://app.box.com/s/1n95rbe8rb5l1puixa8dde4o53qmyp7x

The first two tables are the relevant ones.

 

[hiker95]

bandaanders,

Thanks for the workbook.

Here is a macro solution for you to consider, that will work on the cells in a Selection.

Sample raw data in the active worksheet with range A1:E4 selected:

Excel 2007
	A	B	C	D	E
1	Albert	Albert	5	Albert_Max	8
2	6	7	57	7	Max
3	Max	g5	Max	G5	8
4	viii		viii	viii	8
5
6
7	Albert	Albert	5	Albert_Max	8
8	6	7	57	7	Max
9	Max	g5	Max	G5	8
10	viii		viii	viii	8
11
Tabelle1

After the macro:

Excel 2007
	A	B	C	D	E
1	Albert	Albert	5	Albert_Max	8
2	6	7	57	7	Max
3	Max	g5	Max	G5	8
4	viii		viii	viii	8
5
6
7	Albert	Albert	5	Albert_Max	8
8	6	7	57	7	Max
9	Max	g5	Max	G5	8
10	viii		viii	viii	8
11
Tabelle1

And, after the macro with range A7:E10 selected:

Excel 2007
	A	B	C	D	E
1	Albert	Albert	5	Albert_Max	8
2	6	7	57	7	Max
3	Max	g5	Max	G5	8
4	viii		viii	viii	8
5
6
7	Albert	Albert	5	Albert_Max	8
8	6	7	57	7	Max
9	Max	g5	Max	G5	8
10	viii		viii	viii	8
11
Tabelle1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub MarkDuplicatesInEachRow()
' hiker95, 08/30/2015, ME879303
Dim wa As Worksheet
Dim sr As Long, rc As Long, er As Long, sc As Long, cc As Long, ec As Long
Dim r As Long, nsr As Long, c As Range, rng As Range
Application.ScreenUpdating = False
Set wa = ActiveSheet
With wa
  With Selection
    .Locked = False
    .Interior.Pattern = xlNone
    .Interior.TintAndShade = 0
    .Interior.PatternTintAndShade = 0
    sr = .Row
    If sr = 1 Then
      rc = .Rows.Count
      er = sr + rc - 1
      sc = .Column
      cc = .Columns.Count
      ec = sc + cc - 1
      For r = sr To er Step 1
        Set c = Nothing
        Set rng = Nothing
        Set rng = wa.Range(wa.Cells(r, sc), wa.Cells(r, ec))
        For Each c In rng
          If Not c = vbEmpty Then
            If Application.CountIf(rng, c) > 1 Then c.Interior.Color = vbYellow
          End If
        Next c
      Next r
    ElseIf sr > 1 Then
      nsr = sr
      rc = .Rows.Count
      er = nsr + rc - 1
      sc = .Column
      cc = .Columns.Count
      ec = sc + cc - 1
      For r = nsr To er Step 1
        Set c = Nothing
        Set rng = Nothing
        Set rng = wa.Range(wa.Cells(r, sc), wa.Cells(r, ec))
        For Each c In rng
          If Not c = vbEmpty Then
            If Application.CountIf(rng, c) > 1 Then c.Interior.Color = vbYellow
          End If
        Next c
      Next r
    End If
  End With
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the MarkDuplicatesInEachRow macro.

 

[bandaanders]

Hi hiker95,

it works as intended.
Also, the instructions, you provided, are brilliant and noob-proof!
Thank you very much for your good work and your time!