View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Monomeeth Monomeeth is offline
external usenet poster
 
Posts: 63
Default Help! Cant debug macro used to delete duplicate rows

Hi Everyone

I have a macro which works really well, except if the user decides to cancel
it. The macro is designed so that users can delete duplicate rows based on
the cell contents of between 1 and 5 columns.

For instance, if a user wants to simply delete all duplicates based on
Employee Number and column E contains the Employee Numbers, the user runs the
macro and types E into the input box and the macro simply goes down column E
and deletes any rows containing duplicates in that column. The user can
select more than one column, for instance typing in E,F,J means the macro
would check for any rows with duplicates based on cells in all three columns
matching.

The problem is that once Users run the macro, if they decide to cancel, it
actually still runs and deletes every single row containing data. I can't
seem to find the problem, hence my seeking your help!

:)

The code is below:




Sub DeleteDuplicatesUpTo5Columns()

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 up to 5 Column Letters to compare, seperated by
commas" & vbCrLf & "[e.g. 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