macro Highligh the repeated values in a cell

[sasi]

I wanted to Highlighted the repeated values wirh red color in cell.
I have around 50 columns in a sheet, some of the values in a column cells are repeating those should be identified with red color.
Normal sheet1, macro should handle all type values numeric,alphanumeric,Decimal...(A1,2A1,1.1,75,....)

<TABLE style="WIDTH: 183pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=244 x:str><COLGROUP><COL style="WIDTH: 59pt; mso-width-source: userset; mso-width-alt: 2889" width=79><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 76pt; mso-width-source: userset; mso-width-alt: 3693" width=101><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 59pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl29 height=17 width=79>SNO</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl32 width=64>Quantity</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 76pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid" class=xl26 width=101>Refdes</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl30 height=17 x:num>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl33 x:num>5</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 1pt solid" class=xl27>C1,C2,C2,C3,C4</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl30 height=17 x:num>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl33 x:num>6</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 1pt solid" class=xl27>77,88,99,1,1</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 13.5pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl31 height=18 x:num>3</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl34 x:num>7</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 1pt solid" class=xl28>1C1,1C2,1C3,1C3</TD></TR></TBODY></TABLE>

After running the macro result supposed to be like this
<TABLE style="WIDTH: 191pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=255 x:str><COLGROUP><COL style="WIDTH: 59pt; mso-width-source: userset; mso-width-alt: 2889" width=79><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 84pt; mso-width-source: userset; mso-width-alt: 4096" width=112><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; WIDTH: 59pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl29 height=17 width=79>SNO</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl32 width=64>Quantity</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 84pt; BORDER-TOP: windowtext 1pt solid; BORDER-RIGHT: windowtext 1pt solid" class=xl26 width=112>Refdes</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl30 height=17 x:num>1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl33 x:num>5</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 1pt solid" class=xl27>C1,C2,C2,C3,C4</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 12.75pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl30 height=17 x:num>2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl33 x:num>6</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 1pt solid" class=xl27>77,88,99,1,1</TD></TR><TR style="HEIGHT: 13.5pt" height=18><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext 1pt solid; BACKGROUND-COLOR: transparent; HEIGHT: 13.5pt; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl31 height=18 x:num>3</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 0.5pt solid" class=xl34 x:num>7</TD><TD style="BORDER-BOTTOM: windowtext 1pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; BORDER-TOP: windowtext; BORDER-RIGHT: windowtext 1pt solid" class=xl28>1C1,1C2,1C3,1C3</TD></TR></TBODY></TABLE>

Can any one help me
Thanks

 

[pgc01]

Hi sasi

2 points

1 - what should happen if there is more that one substring repeated, like

a,b,c,d,a,c,a

a and c are repeated. Should they both be coloured with the same colour or with different colours?

2 -

macro should handle all type values numeric,alphanumeric,Decimal...

This is no good. If you include an ellipsis it means there are other cases that you are not mentioning and so the code cannot deal with them.

Please be rigorous in the specification of what is a value, for ex.

"a sequence of characters including uppercase letters, digits and dots delimited by a comma or a space"

 

[sasi]

Apologies gentle man,please go through the answers
1.I required in one color for highlight if any multiple repeated values, if you track in multiple repeated values in different color really good.
2 With regards to second point
macro consider A=a there is no restriction in uppercase and lower case.
Digits-1.1,45.001,0.11
Space- C1 ,C2 macro consider as C1,C2
delimited- i am not having these kind of values for now.
Thanks.

 

[pgc01]

Ok, I'm leaving now but I'll post a solution later.

 

[pgc01]

Hi sasi

To test, write text in some cells in column A, starting in A2, down.

I used the spec that I posted before. Hope it's adequate.

Please test.

Sub ColourDups()
Dim r As Range, rC As Range
Dim rex As Object, rexMatch As Object
Dim s As String, s1 As String, sPattern As String
Dim lInd As Long
Dim vColours As Variant
 
vColours = Array(vbRed, vbBlue, vbGreen, vbYellow) ' beyond 3rd repeated substring use the last array value
Set r = Range("A2", Range("A" & Rows.Count).End(xlUp))
 
Set rex = CreateObject("VBScript.RegExp")
rex.Global = True
rex.IgnoreCase = True
sPattern = "\b([A-Z0-9\.]+)(?![._])\b(?=.*\b\1(?![._])\b)"
 
For Each rC In r
    s = rC.Value
    lInd = -1
    Do
        rex.Pattern = sPattern
        If Not rex.test(s) Then Exit Do Else s1 = rex.Execute(s)(0)
        rex.Pattern = "\b" & Replace(s1, ".", "\.") & "(?![._])\b"
        If lInd < UBound(vColours) Then lInd = lInd + 1
        For Each rexMatch In rex.Execute(s)
            rC.Characters(rexMatch.firstindex + 1, Len(s1)).Font.Color = vColours(lInd)
        Next rexMatch
        s = rex.Replace(s, String(Len(s1), " "))
    Loop
Next rC
End Sub

 

[pgc01]

Hi

I found a flaw in the code I posted. Use this instead.

To test, write text in some cells in column A, starting in A2, down.

I used the spec that I posted before. Hope it's adequate.

Please test.

Sub ColourDups()
Dim r As Range, rC As Range
Dim rex As Object, rexMatch As Object
Dim s As String, s1 As String, sPattern As String
Dim lInd As Long
Dim vColours As Variant
 
vColours = Array(vbRed, vbBlue, vbGreen, vbYellow) ' beyond 3rd repeated substring use the last array value
Set r = Range("A2", Range("A" & Rows.Count).End(xlUp))
 
Set rex = CreateObject("VBScript.RegExp")
rex.Global = True
rex.IgnoreCase = True
sPattern = "[^A-Z0-9.]([A-Z0-9.]+)(?![A-Z0-9.])(?=.*[^A-Z0-9.]\1(?:[^A-Z0-9.]|$))"
 
For Each rC In r
    s = " " & rC.Value
    lInd = -1
    Do
        rex.Pattern = sPattern
        If Not rex.test(s) Then Exit Do Else s1 = Mid(rex.Execute(s)(0), 2)
        rex.Pattern = "[^A-Z0-9.]" & Replace(s1, ".", "\.") & "(?![A-Z0-9.])"
        If lInd < UBound(vColours) Then lInd = lInd + 1
        For Each rexMatch In rex.Execute(s)
            rC.Characters(rexMatch.firstindex + 1, Len(s1)).Font.Color = vColours(lInd)
        Next rexMatch
        s = rex.Replace(s, String(1 + Len(s1), " "))
    Loop
Next rC
End Sub

 

[sasi]

Thanks Gentlman,its working as expected.Few requirements.
I have a Button in sheet4 placed this macro(ColourDups) , i am supposed test on sheet1 if any repeated values in column cells sheet1 is refreshing every time when i click the button where it is resided in sheet4. i wanted range A2:Z2000,i have written following way but error occuring,can you please correct it.

Set r = Sheet1.Range("A2:Z2000", Range("A" & Rows.Count).End(xlUp))

 

[pgc01]

Hi

I'm glad it's working. If I understand correctly you want r to refer to the range in columns A:Z in Sheet1, from row 2 till the last row of column A with data.

You cannot mix ranges from different worksheets as you do in your statement. You are mixing the first range object from Sheet1 with the others inside that are from the active sheet, in your case Sheet4.

Try:

Set r = Sheet1.Range("A2:Z" & Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row)

or

With Sheet1
    Set r = .Range("A2:Z" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With