Remove duplicat entry w/out deleting cell
Hi there,
In Excel2003 If have created the macro below.
It loops thru row 2 upto 877 and for each row it look of al values in
the row are present in one of the rows above the one currently check.
Remark:
It takes a while to run this macro.
Sub pgarcia()
Dim iRow1 As Integer
Dim iRow2 As Integer
Dim iCol As Integer
Dim iDup As Integer
Dim rCol As Range
Dim lVal As Long
Dim iStart As Integer
iStart = 2
' Start with second data row
' With 1 row of headers use 3
For iRow1 = iStart To 877
Range(Cells(iRow1, 1), Cells(iRow1, 7)).Select
For iRow2 = iStart - 1 To iRow1 - 1
iDup = 0
For iCol = 1 To 14 ' A - N
If Cells(iRow1, iCol).Value = _
Cells(iRow2, iCol).Value Then
iDup = iDup + 1
End If
Next
If iDup = 7 Then
Exit For
End If
Next
If iDup = 7 Then
Selection.ClearContents
End If
Next
Cells(1, 1).Select
End Sub
HTH,
Wouter
|