Highlight Partial Duplicates

[eliseamor]

Hi,

I am trying to create a schedule, and want the cell to highlight when there is a duplicate.
My problem is that sometimes the cell has one person, and sometimes it has multiple people, and I want to highlight when a person has been put into more than one task.

e.g.

[TABLE="width: 500"]
<tbody>[TR]
[TD]Task
[/TD]
[TD]Person
[/TD]
[/TR]
[TR]
[TD]Cleaning[/TD]
[TD]AS + EK[/TD]
[/TR]
[TR]
[TD]Filing[/TD]
[TD]JS[/TD]
[/TR]
[TR]
[TD]Scanning[/TD]
[TD]AS[/TD]
[/TR]
[TR]
[TD]Deliveries[/TD]
[TD]EK + TL[/TD]
[/TR]
[TR]
[TD]Phones[/TD]
[TD]JS[/TD]
[/TR]
</tbody>[/TABLE]

Here you can see that AS, EK and JS are both in two tasks.
I can get JS to highlight using conditional formatting, as it is an exact duplicate. How can I get the cells that contain AS and EK to highlight as well?

 

[Glove_Man]

Use conditional formatting, but instead of an exact match, use Conditional Formatting | New Rule | Use a formula to determine which cells to format

Then, with the formula =NOT(ISERROR(FIND("AS",B2)))

 

[kweaver]

Welcome, EliseAmor.

I made the assumption that all people would be only 2 characters (initials) and that
no more than 2 people would do a task.

I think this macro will do it then:

Sub HiDup()
Dim pos As Integer, i As Integer, j As Integer
Dim ckL As String, ckR As String
Dim LR As Long
LR = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To LR
 pos = 0
 ckL = Left(Range("B" & i), 2)
 ckR = Right(Range("B" & i), 2)
 For j = 2 To LR
 pos = pos + (--((InStr(1, Range("B" & j), ckL)) Or (InStr(1, Range("B" & j), ckR))))
 Next j
  If pos > 1 Then
   Cells(i, 2).Interior.ColorIndex = 34
   Else
  End If
 Next i
End Sub

 

[kweaver]

Oops...sorry. Change this line:

 pos = pos + (--((InStr(1, Range("B" & j), ckL)) Or (InStr(1, Range("B" & j), ckR))))

To

 pos = pos + (-((InStr(1, Range("B" & j), ckL)) Or (InStr(1, Range("B" & j), ckR))))

 

[Akuini]

Is there always a '+' between 2 names?
If yes then try this:

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1107015a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1107015-highlight-partial-duplicates.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
 
va = Range([COLOR=brown]"B1"[/COLOR], Cells(Rows.count, [COLOR=brown]"B"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
d.CompareMode = vbTextCompare
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
arr = Split(va(i, [COLOR=crimson]1[/COLOR]), [COLOR=brown]"+"[/COLOR])
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] x [COLOR=Royalblue]In[/COLOR] arr
        x = Trim(x)
        [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] d.Exists(x) [COLOR=Royalblue]Then[/COLOR]
        d(x) = i
        [COLOR=Royalblue]Else[/COLOR]
        Cells(i, [COLOR=brown]"B"[/COLOR]).Interior.Color = vbYellow
        Cells(d(x), [COLOR=brown]"B"[/COLOR]).Interior.Color = vbYellow
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]
 
 
[COLOR=Royalblue]Next[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]