delete duplicate information

K

kre2000

ok, this is no ordinary delete duplicate data script.

i need a script which will scan an excel doc with 20 columns an
thousands of rows. if the script finds a piece of duplicate data i
column 4 then the two rows compare. if the rows with duplicate data i
column 4 also have also have duplicate data in column three, then on
of the rows is deleted (it really doesn’t matter which).

i've tried adopting several scripts which scan 1 column but cannot see
to get them to work. can anyone help me out?

thanks in advance!:
 
M

mudraker

Kre2000

try


Sub DelDups()
Dim l As Long
Dim x As Long
Dim sTxt As String

For l = Range("D" & Rows.Count).End(xlUp).Row To 2 Step 1
sTxt$ = Cells(l, "d").Value
For x = l - 1 To 1 Step 1
If Cells(x, "d").Value = sTxt Then
If Cells(l, "c").Value = Cells(x, "d").Value Then
Rows(l).Delete
' exit for if looking for only 1 duplicate
End If
End If
Next x
Next l
End Su
 
K

kre2000

mudraker,

i copied your script into my workbook and it didnt seem to do anything
i tried to tweak it a little by having it count down through eac
column, etc. but to no avail.

so, i tried to throw in some MsgBox lines to see where the script wa
running and after the first for loop ... For l = Range("D"
Rows.Count).End(xlUp).Row To 2 Step 1 ... nothing appears (as when
have it MsgBox l)--it seems, for some reason, this code i
unreachable.

I appreciate your help!!! :
 
M

mudraker

Kre200

Oops My mistake

in each for loop

Step 1

should be

Step -1


Sub DelDups()
Dim l As Long
Dim x As Long
Dim sTxt As String

For l = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
sTxt$ = Cells(l, "d").Value
For x = l - 1 To 1 Step -1
If Cells(x, "d").Value = sTxt Then
If Cells(l, "c").Value = Cells(x, "c").Value Then
Rows(l).Delete
' exit for if looking for only 1 duplicate
End If
End If
Next x
Next l
End Su
 
M

mudraker

Kre2000

Also need to activate exit for statement to prevent error occurin
after a row has been deleted

Sub DelDups()
Dim l As Long
Dim x As Long
Dim sTxt As String

For l = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
sTxt$ = Cells(l, "d").Value
For x = l - 1 To 1 Step -1
If Cells(x, "d").Value = sTxt Then
If Cells(l, "c").Value = Cells(x, "c").Value Then
Rows(l).Delete
Exit For
End If
End If
Next x
Next l
End Su
 
Top