Macro or formula to check for Dupes

[coliervile]

Goooooood morning to everyone-

I have a list of 18 employee names and they are paired together as work teams in columns "X" and "Y" the range is X1:Y18. I would like a macro that would check for dupes of pairings. Here is what I'm looking; in the list below the employees are paired off. I want to check to see if the employees work more than once together. On the sixth line Mary and Robin work together and they also work together on the eighteenth line too. This occurrence also happens with Mike and Lisa. How is the best way to check this or show the result of these occurrences.


Tom---Duane
Mike---Lisa
Steve---Katie
Chris---William
Neal ---Chris
Mary---Robin
Elizabeth---Don
Ann---Elizabeth
Tim---Steve
William---Tom
Terry---Ann
Rich---Gale
Gale---Neal
Don---Rich
Lisa---Mike
Duane---Tim
Katie---Terry
Robin---Mary

Best regards,
Charllie

 

[patel45]

this code uses column Z for service

Sub aa()
Dim cell As Range
r1 = 1
r2 = 18
For r = r1 To r2
  Range("Z" & r) = Range("Y" & r) & "," & Range("X" & r)
Next
For r = r1 To r2
  s = Range("X" & r) & "," & Range("Y" & r)
  If Application.WorksheetFunction.CountIf(Range("Z1:Z18"), s) > 0 Then
    Range("X" & r & ":Y" & r).Interior.ColorIndex = 6
  End If
Next
Range("Z" & r1 & ":Z" & r2).ClearContents
End Sub

 

[coliervile]

Very nice code "patel45". After running the macro and the color index is filled in I moved the names around and tried running the code again, but the original color index remained the same even though there were no matches. I select columns X and Y an manually remove the fill colors (using the No Fill) and then ran the code and it worked. Should your code remove any prvious fill colors when run a second time?

Best regards,
Charlie

 

[coliervile]

"patel45" it added this to you coding and it seems to remove the old color index:

Private Sub aa()
Dim cell As Range
r1 = 1
r2 = 12
For r = r1 To r2
******Range("X" & r & ":Y" & r).Interior.ColorIndex = 0***** New code added in
Range("Z" & r) = Range("Y" & r) & "," & Range("X" & r)
Next
For r = r1 To r2
s = Range("X" & r) & "," & Range("Y" & r)
If Application.WorksheetFunction.CountIf(Range("Z1:Z12"), s) > 0 Then
Range("X" & r & ":Y" & r).Interior.ColorIndex = 6
End If
Next

Thanks for your help.

Best regards,
Charlie
Range("Z" & r1 & ":Z" & r2).ClearContents
End Sub

 

[coliervile]

If I wanted to place this coding into a module to only run on worksheet "Sheet2" where would I insert that into the code?

Best regards,
Charlie

 

[patel45]

Private Sub aa()
Dim cell As Range
[COLOR=#ff0000]Sheet2.select[/COLOR]
r1 = 1
r2 = 12
For r = r1 To r2
    Range("X" & r & ":Y" & r).Interior.ColorIndex = 0
  Range("Z" & r) = Range("Y" & r) & "," & Range("X" & r)
Next
For r = r1 To r2
  s = Range("X" & r) & "," & Range("Y" & r)
  If Application.WorksheetFunction.CountIf(Range("Z1:Z12"), s) > 0 Then
    Range("X" & r & ":Y" & r).Interior.ColorIndex = 6
  End If
Next
Range("Z" & r1 & ":Z" & r2).ClearContents
End Sub

 

[coliervile]

Thank you patel45 for your help.

Best regards,
Charlie