Deleting duplicates

A

Alex

I have the following code, which does exactly what I've asked it to do;
deletes entire rows where there is a duplicate value. My problem is that I
have conditional formatting and formulas in 5000 rows. When duplicates are
deleted, naturally so are my formulas and formats. I need the formats and
formulas in all 5000 rows, even after the duplicates have been
deleted/cleared. Any ideas how I can do this? I have code that imports the
data into a sheet2, deletes duplicates, etc. If needed, I can import the
data into sheet1, delete duplicates, then copy and paste remaining rows to
sheet2. I was having problems with this too. Thanks for your help.

Selection.Sort Key1:=Range("L2"), Order1:=xlAscending, Key2:=Range("M2") _
, Order2:=xlAscending, Key3:=Range("N2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, Key2:=Range("J2") _
, Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Key2:=Range("G2") _
, Order2:=xlAscending, Key3:=Range("H2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Key3:=Range("E2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

LastRow = Worksheets("ImportData").Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Worksheets("ImportData").Cells(1,
Columns.Count).End(xlToLeft).Column
myRange = Worksheets("ImportData").Range("A1:A" & LastRow)
For i = LastRow To 2 Step -1
If Cells(i, 1) = Cells(i, 1).Offset(-1, 0) And _
Cells(i, 2) = Cells(i, 2).Offset(-1, 0) And _
Cells(i, 3) = Cells(i, 3).Offset(-1, 0) And _
Cells(i, 4) = Cells(i, 4).Offset(-1, 0) And _
Cells(i, 5) = Cells(i, 5).Offset(-1, 0) And _
Cells(i, 6) = Cells(i, 6).Offset(-1, 0) And _
Cells(i, 7) = Cells(i, 7).Offset(-1, 0) And _
Cells(i, 8) = Cells(i, 8).Offset(-1, 0) And _
Cells(i, 9) = Cells(i, 9).Offset(-1, 0) And _
Cells(i, 10) = Cells(i, 10).Offset(-1, 0) And _
Cells(i, 11) = Cells(i, 11).Offset(-1, 0) And _
Cells(i, 12) = Cells(i, 12).Offset(-1, 0) And _
Cells(i, 13) = Cells(i, 13).Offset(-1, 0) And _
Cells(i, 14) = Cells(i, 14).Offset(-1, 0) Then
Cells(i, 1).EntireRow.Delete
End If
Next
 
J

Joel

from
Cells(i, 1).EntireRow.Delete
to
Range("A" & i & ":N" & i) = ""

But this will leave blanks in the middle. Probably not what you want. You
can then do a sort and group these items together.


Other choice would be to copy the formula only using paste special
Range("A1:N1").copy
Range("A2:N5000).pastespecial _
Operation:=xlPasteFormulas
 

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