Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
macro to delete rows below the first row with duplicate data | Excel Programming | |||
Delete duplicate rows using macro recorder | Excel Programming | |||
macro to delete duplicate rows using Filter | Excel Programming | |||
Macro to delete duplicate/triplicate rows | Excel Programming | |||
Macro to delete duplicate/triplicate rows | Excel Programming |