#1
|
|||
|
|||
in each row mark duplicates
Hi, could someone please help me with this problem? I would like to have a makro, that marks duplicates in each row in red. The solution should look like seen in the screenshot or in xlsm. Thank you in advance! |
#2
|
||||
|
||||
You don't need a macro for this - you can do it with a conditional format using the formula:
=COUNTIF($A$1:A1,A1)>1
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Thank you very much for your reply!
I was not clear about the specification (sorry!): 1) There are more than one row 2) it has to be a macro |
#4
|
||||
|
||||
You can do it with conditional formatting for however many rows of data you have> A macro isn't needed, so why are you insistent on one?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Because in fact it is a very large table and it seems conditional formating cripples performance (furthermore it needs only to run once)
|
#6
|
||||
|
||||
Try:
Code:
Sub Demo() Application.ScreenUpdating = False Dim lRow As Long, lCol As Long, r As Long, c As Long With ActiveSheet .UsedRange With .Cells.SpecialCells(xlCellTypeLastCell) lRow = .Row lCol = .Column End With For r = 1 To lRow For c = 2 To lCol If Application.WorksheetFunction.CountIf(.Range(.Cells(r, 1), .Cells(r, c)), .Cells(r, c).Value) > 1 Then .Cells(r, c).Font.ColorIndex = 3 End If Next Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Great! Thank you! This helps me a lot!
(only thing is: makro does not make a distinction between "smith" and "Smith", but I can live with that) |
#8
|
|||
|
|||
Mark Duplicates
This one makes distinction between smith and Smith
Sub MarkDups() Dim SRange As Range Set SRange = Range("A1", Range("A1").End(xlToRight)) Dim c As Range For Each c In SRange Set c = SRange.Find(c, , , xlWhole, , , True) If Not c Is Nothing Then Dim firstAddress As String firstAddress = c.Address Do Set c = SRange.FindNext(c) If c.Address <> firstAddress Then c.Font.Color = vbRed End If Loop While Not c Is Nothing And c.Address <> firstAddress End If Next c End Sub |
#9
|
||||
|
||||
KunleExcel: Your code colours not only the duplicate but also the original. Also, it processes only the first row, not all rows. Finally, when posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
|||
|
|||
Code:
Sub dcmdc() Dim d As Object, r, s Set d = CreateObject("scripting.dictionary") d.comparemode = 0 For Each r In ActiveSheet.UsedRange.Rows For Each s In r.Cells If Len(s) > 0 Then _ If d(s.Value) = 1 Then s.Font.Color = vbRed Else d(s.Value) = 1 Next s d.RemoveAll Next r End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Sequencing duplicates | balajigade | Excel Programming | 3 | 10-04-2015 03:31 PM |
VBA: Delete duplicates in each row | bandaanders | Excel Programming | 2 | 09-02-2015 08:15 AM |
Removing duplicates | saurabhlotankar | Excel Programming | 14 | 05-26-2015 10:13 AM |
Mail duplicates | mixy | Outlook | 0 | 02-10-2011 12:54 AM |
sum of duplicates | zxmax | Excel | 1 | 09-29-2006 08:29 PM |