joel;617710 Wrote:
First, the code you have posted will not work because you need to sort
by all columns you are comparing.
Suppose you have two columns of data as shown below
Col D Col E
A X
A Y
A X
If you sort only by Column A you will not remove all the duplicates.
If you were writing generic code to do 5 columns you would need to
specify up to 5 column. You also would want to return the data to its
original order so not to confuse people. So you need to add a new
column containing the original row number and then at the end sort by
the new column and then delete the new column.
Try this generic code. It will work with any number of columns
Sub DeleteDuplicates2Columns()
Dim Col As Variant
Dim ColNum As Long
Dim LastRow As Long
Dim Response As String
Dim RowCount As Long
Dim SelectCols As Variant
Application.ScreenUpdating = False
Response = InputBox("Enter 5 Column Letters to compare seperated by
commas" & vbCrLf & _
"[ie A,D,E]")
SelectCols = Split(Response, ",")
'covert column letters to numbers
For Each Col In SelectCols
ColNum = Val(Range(Trim(Col) & "1").Column)
Col = ColNum
Next Col
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'Add row number to each row
For RowCount = 1 To LastRow
Range("IV" & RowCount) = RowCount
Next RowCount
'sort by each column
For Each Col In SelectCols
Rows("1:" & LastRow).Sort _
header:=xlYes, _
key1:=Cells(1, Col), _
order1:=xlAscending
Next Col
For RowCount = LastRow To 2 Step -1
Match = True
For Each Col In SelectCols
If Cells(RowCount, Col) < Cells(RowCount - 1, Col) Then
Match = False
Exit For
End If
Next Col
If Match = True Then
Rows(RowCount).Delete
End If
Next RowCount
'return order to original order
Rows("1:" & LastRow).Sort _
header:=xlYes, _
key1:=Range("IV1"), _
order1:=xlAscending
'delete column with row numbers
Columns("IV").Delete
Application.ScreenUpdating = True
End Sub
Hi there this was really great and as a newbie assisted greatly . One
question is would it be possible to addapt this script to only delete
rows that have zero's in the nominated columns? Thanks in advance
--
malstan
------------------------------------------------------------------------
malstan's Profile: 1467
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=171629
Microsoft Office Help