Clear duplicate values

Joined
Jul 25, 2007
Messages
26
Reaction score
0
To All,
I am trying to sort an array (AB27:AC44) then compare the value in two cells (AB28 & AC28) with the two cells above (AB27:AC28) if they are the same then clear AB28 & AC29, then resort, then select the next down and compare. The following is my code which I can't get to work as I want.
Sub CompareCellValueAndClearExtraCells()
Application.ScreenUpdating = False
Dim MyCounter
MyCounter = 1
''Sort the values
Range("AB27:AC44").Select
Selection.sort Key1:=Range("AC27"), Order1:=xlAscending, Key2:=Range( _
"AB27"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal

''Select the second on the list and delete duplicates
Range("AB28").Select
Do Until MyCounter = 17
MyCounter = MyCounter + 1
If ActiveCell.Value = ActiveCell.Offset(-1, 0) Then
If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1) Then
ActiveCell.Range("A1:B1").Select
Selection.ClearContents
End If
End If
Range("AB27:AC44").Select
Selection.sort Key1:=Range("AC27"), Order1:=xlAscending, Key2:=Range( _
"AB27"), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal

Range("AB28").Select
If ActiveCell.Value = ActiveCell.Offset(-1, 0) Then
If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(-1, 1) Then
ActiveCell.Range("A1:B1").Select
Selection.ClearContents
Else
ActiveCell.Offset(1, 0).Select
End If
End If
Loop

End Sub
Thanks In advance for any help.
Geoffrey Barnard
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top