• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Find Duplicates In Column, and Then Clear (Not Delete) Contents Of Entrie Row

I am looking for a help with a code that will find duplicate entries in column D, and then clear (not delete) the contents of the entire row.


I almost have it with the code beneath, but I think I went wrong somewhere at the end.


[pre]<br />
Sub RemoveDuplicates()<br />
Dim rConstRange As Range, rFormRange As Range<br />
Dim rAllRange As Range, rCell As Range<br />
Dim iCount As Long<br />
Dim strAdd As String<br />
Range("D10:D1000").Select<br />
On Error Resume Next<br />
Set rAllRange = Selection<br />
If WorksheetFunction.CountA(rAllRange) < 2 Then<br />
MsgBox "You selection is not valid", vbInformation<br />
On Error GoTo 0<br />
Exit Sub<br />
End If<br />
Set rConstRange = rAllRange.SpecialCells(xlCellTypeConstants)<br />
Set rFormRange = rAllRange.SpecialCells(xlCellTypeFormulas)<br />
If Not rConstRange Is Nothing And Not rFormRange Is Nothing Then<br />
Set rAllRange = Union(rConstRange, rFormRange)<br />
ElseIf Not rConstRange Is Nothing Then<br />
Set rAllRange = rConstRange<br />
ElseIf Not rFormRange Is Nothing Then<br />
Set rAllRange = rFormRange<br />
Else<br />
MsgBox "No Dupilcate Entries Found", vbInformation<br />
On Error GoTo 0<br />
Exit Sub<br />
End If<br />
Application.Calculation = xlCalculationManual<br />
For Each rCell In rAllRange<br />
strAdd = rCell.Address<br />
strAdd = rAllRange.Find(What:=rCell, After:=rCell, LookIn:=xlValues, _<br />
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _<br />
MatchCase:=False).Address<br />
If strAdd <> rCell.Address Then<br />
ActiveRow.Select<br />
ActiveRow.ClearContents<br />
End If<br />
Next rCell<br />
Application.Calculation = xlCalculationAutomatic<br />
On Error GoTo 0<br />
End Sub<br />
[/pre]
 
Indi

Have a look at :

[pre]
Code:
Sub ClearRows()

Dim i As Long
Dim rng As Range

Set rng = Range("D10:D1000")

For i = 1 To rng.Count - 1
temp = rng.Cells(i).Value
For j = i + 1 To rng.Count
If temp = rng.Cells(j).Value Then
rng.Cells(i).EntireRow.ClearContents
rng.Cells(j).EntireRow.ClearContents
End If
Next j
Next i

End Sub
[/pre]
 
Back
Top