Macro For Duplicates

[Dazzawm]

Is there a macro where I can select a particular column and it will colour in a cells that have the same data in. I know there are formulas and conditional formatting but they seem a bit long winded where you have to add columns, copy/paste values etc, I just want to select any column and it does it all for me. Thanks. Ideally it would be good that if any 2 or 3 cells match they would be red, any other 2 or 3 would be yellow etc.. or if not just one colour would suffice. Thanks.

 

[Peter_SSs]

If you have Excel 2007 or later, there is a built-in Conditional Formatting to do this. If you have an earlier version, you can still do it with Conditional Formatting without using additional columns or copy/pasting. If you need further help, what Excel version are you using?

Edit: It can be done with a macro too, but I would normally use built-in features if they can be applied.

 

[Dazzawm]

I am using 2007. I tried conditional formatting, but it highlighted every cell the same colour. What I really need is for it to find half a dozen cells that are the same and highlight red, another few and highlight yellow etc just to break them up a bit and easier to see.

 

[Peter_SSs]

I am using 2007. I tried conditional formatting, but it highlighted every cell the same colour. What I really need is for it to find half a dozen cells that are the same and highlight red, another few and highlight yellow etc just to break them up a bit and easier to see.

You had said one colour would suffice but if you want to differentiate then yes, I think a macro will be best.

I have assumed ..

- The data to be coloured is in column H, starting at row 2 (heading in row 1).
- Columns Y and Z are available for the code to use as helper columns.

If you need help to adapt to your particular circumstances, post back with more details in relation to my assumptions. Also post back if you need help with how to implement the code.

Test in a copy of your workbook.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> ColourDupes()<br>    <SPAN style="color:#00007F">Dim</SPAN> aData, aDupes, vDupVal<br>    <SPAN style="color:#00007F">Dim</SPAN> rData <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> lColr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lLastRw <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> rData = Range("H2", Range("H" & Rows.Count).End(xlUp))<br>    aData = rData.Value<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    rData.Interior.ColorIndex = xlNone<br>    Range("Y2").Formula = "=COUNTIF(H:H,H2)>1"<br>    Range("H1", Range("H" & Rows.Count).End(xlUp)).AdvancedFilter _<br>        Action:=xlFilterCopy, CriteriaRange:=Range("Y1:Y2"), _<br>        CopyToRange:=Range("Z1"), Unique:=<SPAN style="color:#00007F">True</SPAN><br>    lLastRw = Range("Z" & Rows.Count).End(xlUp).Row<br>    <SPAN style="color:#00007F">If</SPAN> lLastRw > 1 <SPAN style="color:#00007F">Then</SPAN><br>        lColr = 3<br>        aDupes = Range("Z2:Z" & lLastRw).Value<br>        <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> lLastRw - 1<br>            vDupVal = aDupes(i, 1)<br>            lColr = lColr + 1<br>            <SPAN style="color:#00007F">For</SPAN> j = 1 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(aData, 1)<br>                <SPAN style="color:#00007F">If</SPAN> aData(j, 1) = vDupVal <SPAN style="color:#00007F">Then</SPAN><br>                    rData.Cells(j, 1).Interior.ColorIndex = lColr<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Next</SPAN> j<br>        <SPAN style="color:#00007F">Next</SPAN> i<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    Range("Y1").Resize(lLastRw + 1, 2).ClearContents<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[Dazzawm]

Thanks that works a treat. I had to change the 'helper columns' as I had data within those. On the conditional formatting subject I did try as you said with that but after any macro I run was taking minutes rather than seconds. How do I get rid of the conditional formatting because that seemed to have an affect on the speed of the macro. I tried copy/paste values and clear rules but nothing. I also couldn't get rid of the colour.

 

[Peter_SSs]

How do I get rid of the conditional formatting

With the sheet active
Home ribbon|Conditional Formatting|Clear Rules|Clear Rules from Entire Sheet

 

[Dazzawm]

As I said Peter I tried clear rules and it didn't work.

 

[Dazzawm]

Actually it didn't work. A macro I run is taking ages when it should be instant.

 

[mirabeau]

Not clear what is your current status on this one.

is it that you want a fast macro to color duplicate values?

 

[Peter_SSs]

As I said Peter I tried clear rules and it didn't work.

What didn't work?

a) Clearing the Conditional Formatting? How do you know that bit hasn't been cleared?

b) The subsequent macro didn't work? If so, what did it do?

c) Are other macros, that we don't yet know about, involved with this sheet as well?