Duplicates Different Font Color

[Jaye7]

I posted this previously but had no real answers to the question therefore I will try again hoping for someone with great skills.

I have the following code which highlights any duplicates in Column A to FONT color red and then I have the option to delete the rows.
The first bit of my code Call SELECTION_RANGE calls up an inputbox which I can use to select whole range, partial range etc...

OK, so what I would like is if it finds duplicates it will highlight the first duplicate of the same value red FONT, the second duplicate blue FONT, the third green FONT etc.... if someone can help with a script I can then add other colors etc...

Please do not provide links to other websites as usually the code is not specific to what I am after and I am not good at writing scripts.

example

K2204S FONT WILL BE COLOR (BLACK)
K2204S '' (RED)
K2204S '' (BLUE)
K2004S '' (GREEN)
DB1085 '' (BLACK)
DB1085 '' (RED)
DB1085 '' (BLUE)
DB1085 '' (GREEN)



code:

Call SELECTION_RANGE
Application.ScreenUpdating = False
'
rng = Selection.Rows.Count
For I = rng To 1 Step -1
myCheck = ActiveCell
ActiveCell.Offset(1, 0).Select
For j = 1 To I
If ActiveCell = myCheck Then
Selection.Font.Bold = False
Selection.Font.ColorIndex = 3
End If
ActiveCell.Offset(1, 0).Select
Next j
ActiveCell.Offset(-I, 0).Select
Next I
YesNo = MsgBox("Click Yes To Keep Duplicates or No To Delete Duplicates?", vbYesNo + vbCritical, "Caution, Do You Want To Keep Duplicates")
Select Case YesNo
Case vbYes
Case vbNo
xDeleteDuplicates
End Select
Application.ScreenUpdating = True
End Sub

<!-- / message -->

 

[hiker95]

Jaye7,


Sample data before the macro:

Excel Workbook
	A
1	K2204S
2	DB1085
3	K2204S
4	DB1085
5	K2204S
6	DB1085
7	K2204S
8	DB1085
9
Sheet1

After the macro (I used column B as a counter area):

Excel Workbook
	A
1	K2204S
2	DB1085
3	K2204S
4	DB1085
5	K2204S
6	DB1085
7	K2204S
8	DB1085
9
Sheet1

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).

Option Explicit
Sub ColorDups()
' hiker95, 08/20/2010, ME489857
Dim c As Range
Application.ScreenUpdating = False
With Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
  .FormulaR1C1 = "=COUNTIF(R1C1:RC[-1],RC[-1])"
  .Value = .Value
End With
For Each c In Range("B1", Range("B" & Rows.Count).End(xlUp))
  Select Case c
    Case 1
      c.Offset(, -1).Font.ColorIndex = 1    'Black
    Case 2
      c.Offset(, -1).Font.ColorIndex = 3    'Red
    Case 3
      c.Offset(, -1).Font.ColorIndex = 5    'Blue
    Case 4
      c.Offset(, -1).Font.ColorIndex = 4    'Green
  End Select
Next c
Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Application.ScreenUpdating = True
End Sub

Then run the "ColorDups" macro.

 

[hiker95]

Jaye7,


The formula I used in cell B1 (copied down):

=COUNTIF($A$1:A1,A1)

 

[Jaye7]

Hiker95,

This is brilliant, exactly what I am after, I have just enough experience that I can modify the code to insert a column if I already have text in column B and add more colors.
Thanks so much, Have a great day (or night).

 

[Nalani]

Well Jaye7 I would like to thank you for abondoning your original thread.
http://www.mrexcel.com/forum/showthread.php?t=489609

All my attempts was to try and help you out. Your code that you had posted didn't make since because it was only a snippet.

The link was only an attempt to help out on assumed existing code and or data layout. the line in you posted code xDeleteDuplicates didn't make since and threw an error right off.

This is why I suggested posting Samples.

And not to mention you had changed your requirement to Font instead of Cell Fill.

In my opinion, this comes pretty close to a "Double Post" . Let the Mod's figure it out.

Please, when you post a thread, stick to that thread. It helps for those that "try" to keep trying to solve your problem. Not to find out latter you solved the problem by recreating the thread.

I'm done ranting.

Have a great day, and continue Excel ing

 

[hiker95]

Jaye7,

Thank you very much - come back anytime.

 

[Jaye7]

Sorry to upset you Nalani, but if you read the original thread it did state that I wanted font not cell color under the following line.

K2204S FONT WILL BE COLOR (BLACK).

No one other than you responded and nothing that you posted was helping and I needed an answer quickly, I changed my currently thread so that people would not be able to miss that I needed font color.

I also find it painful when people direct me to other web sites or forum threads as typically the scripts are designed for a specific application and do not fit my situation.

Once again, sorry to upset you but I needed the solution quickly.