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:
<!-- / message -->
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:
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
Last edited by a moderator: