View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
jetted jetted is offline
external usenet poster
 
Posts: 1
Default HOW TO LOCATE DUPLICATES ON TWO COLUMNS


hi

Would this be acceptable (put this in a module and run macro "main")
Sub main()
'Concatenate col a and col c
rowcount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
For i = 1 To rowcount
Range("a" & i).Select
val1 = ActiveCell.Value
Range("c" & i).Select
val2 = ActiveCell.Value
Range("d" & i).Select
ActiveCell.Value = val1 & val2
Next
Call sort_cold
Call hightligh_duplicate
Call clean_up
End Sub
Sub sort_cold()
rowcount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
Range("a1:" & "d" & rowcount).Select
Selection.Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("a1").Select
End Sub
Sub hightligh_duplicate()
Range("d1").Select
FirstItem = ActiveCell.Value
seconditem = ActiveCell.Offset(1, 0).Value
offsetcount = 1
Do While ActiveCell < ""
If FirstItem = seconditem Then
ActiveCell.Offset(0, -3).Select
ActiveCell.Offset(offsetcount, 0).Interior.Color = RGB(255,
0, 0)
ActiveCell.Offset(0, 3).Select
offsetcount = offsetcount + 1
seconditem = ActiveCell.Offset(offsetcount, 0).Value
Else
ActiveCell.Offset(offsetcount, 0).Select
FirstItem = ActiveCell.Value
seconditem = ActiveCell.Offset(1, 0).Value
offsetcount = 1
End If
Loop
ScreenUpdating = True
End Sub

Sub clean_up()
Columns("D:D").Select
Selection.ClearContents
Range("A1").Select
End Sub


--
jetted
------------------------------------------------------------------------
jetted's Profile: http://www.excelforum.com/member.php...o&userid=17532
View this thread: http://www.excelforum.com/showthread...hreadid=563805