Sub ColorDuplicates()
'Color duplicate items between Sheet1.columns A and Sheet2.Column A
For i = 1 To Sheets("Sheet1").Range("A65536").End(xlUp).Row
If Application.WorksheetFunction.CountIf(Sheets("Sheet2").Range("A:A"), Sheets("Sheet1").Range("A" & i)) = 1 Then
With Sheets("Sheet1").Range("A" & i).Font
.ColorIndex = 3
.Bold = True
End With
Else
With Sheets("Sheet1").Range("A" & i).Font
.ColorIndex = 1
.Bold = False
End With
End If
Next i
For i = 1 To Sheets("Sheet2").Range("A65536").End(xlUp).Row
If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Range("A:A"), Sheets("Sheet2").Range("A" & i)) = 1 Then
With Sheets("Sheet2").Range("A" & i).Font
.ColorIndex = 3
.Bold = True
End With
Else
With Sheets("Sheet2").Range("A" & i).Font
.ColorIndex = 1
.Bold = False
End With
End If
Next i
End Sub
Download Link
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment