View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen Per Jessen is offline
external usenet poster
 
Posts: 1,533
Default Help to modify a macro for deleting rows based on two or more colu

Hi Joe

This solution prompt for # of columns to compare (2-5) and then I use one
input box for the user to enter columns to compare. Each column label has to
be seperated by a comma.

Sub DeleteDuplicates2Columns()
Dim LR As Long, i As Long
Dim RowComp
Dim ColToCompare As String
Dim ColArr

Application.ScreenUpdating = False

LR = Range("A" & Rows.Count).End(xlUp).Row
Do
RowComp = InputBox("Enter # of columns to compare (2-5) ", _
"Delete Duplicates", 2)
If RowComp = "" Then Exit Sub
Loop Until RowComp = 2 And RowComp <= 5
ColToCompare = InputBox("Enter column labels of " & _
RowComp & " columns to compare." & vbLf & vbLf & _
"Seperate each column label by a comma, eg. 'A,L'", "Columns to
compare")
If ColToCompare = "" Then Exit Sub
ColArr = Split(ColToCompare, ",")
If UBound(ColArr) + 1 < RowComp Then
msg = MsgBox("Wrong # of columns entered!" & vbLf & vbLf & _
"Ending this macro!", vbExclamation + vbOKOnly, "Input error")
Exit Sub
End If
'--------------
'Sort on Col A
'--------------
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom

'----------------------
'Compare and delete
'----------------------
Select Case ColToCompare
Case 2
For i = LR To 2 Step -1
If Cells(i, ColArr(0)) = Cells(i - 1, ColArr(0)) And _
Cells(i, ColArr(1)) = Cells(i - 1, ColArr(1)) Then
Rows(i).Delete xlShiftUp
End If
Next i
Case 3
For i = LR To 2 Step -1
If Cells(i, ColArr(0)) = Cells(i - 1, ColArr(0)) And _
Cells(i, ColArr(1)) = Cells(i - 1, ColArr(1)) And _
Cells(i, ColArr(2)) = Cells(i - 1, ColArr(2)) Then

Rows(i).Delete xlShiftUp
End If
Next i
Case 4
For i = LR To 2 Step -1
If Cells(i, ColArr(0)) = Cells(i - 1, ColArr(0)) And _
Cells(i, ColArr(1)) = Cells(i - 1, ColArr(1)) And _
Cells(i, ColArr(2)) = Cells(i - 1, ColArr(2)) And _
Cells(i, ColArr(3)) = Cells(i - 1, ColArr(3)) Then

Rows(i).Delete xlShiftUp
End If
Next i
Case 5
For i = LR To 2 Step -1
If Cells(i, ColArr(0)) = Cells(i - 1, ColArr(0)) And _
Cells(i, ColArr(1)) = Cells(i - 1, ColArr(1)) And _
Cells(i, ColArr(2)) = Cells(i - 1, ColArr(2)) And _
Cells(i, ColArr(3)) = Cells(i - 1, ColArr(3)) And _
Cells(i, ColArr(4)) = Cells(i - 1, ColArr(4)) Then

Rows(i).Delete xlShiftUp
End If
Next i
End Select
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Monomeeth" skrev i meddelelsen
...
Hello

I have a macro I have been using to delete duplicate rows which contain
the
same value in two columns. This works well, as long as I manually sort
Column
A in ascending order first, before running the macro. The code is as
follows:

--------------------------

Sub DeleteDuplicates2Columns()
Dim LR As Long, i As Long
Application.ScreenUpdating = False

LR = Range("A" & Rows.Count).End(xlUp).Row

For i = LR To 2 Step -1
If Cells(i, "A") = Cells(i - 1, "A") And _
Cells(i, "L") = Cells(i - 1, "L") Then _
Rows(i).Delete xlShiftUp
Next i

Application.ScreenUpdating = True
End Sub

--------------------------

As you can see, the above code removes duplicate rows if they contain
matching data in columns A and L. In the past if I have needed to change
this
to remove duplicate rows based on matching values in different columns I
just
modified the code. However, I now want to share this with other users who
have no idea about code, so my preference would be to have an input box
where
they can just select the columns.

Also, in the past I have just added another line of code if I wanted the
macro to do the comparisons across three columns. For example:

For i = LR To 2 Step -1
If Cells(i, "A") = Cells(i - 1, "A") And _
Cells(i, "L") = Cells(i - 1, "L") Then _
Rows(i).Delete xlShiftUp
Next i

BECOMES

For i = LR To 2 Step -1
If Cells(i, "A") = Cells(i - 1, "A") And _
Cells(i, "K") = Cells(i - 1, "K") And _
Cells(i, "L") = Cells(i - 1, "L") Then _
Rows(i).Delete xlShiftUp
Next i

So, is there any way to do this in a user-friendly manner for other users?
For instance, using an input box to specify how many columns the user
wants
to interrogate and then having the macro display enough input boxes for
the
user to actually specify the columns. Perhaps this could work if the
number
of columns were restricted to a maximum of 5?

Just out of curiosity, can someone explain why I have to sort Column A
into
ascending order first before running the macro? Is this macro limited in
some
way so that it only compares the rows one at a time adjacent to one
another?
If so, how could I modify the macro so that this isn't the case? Perhaps
it
would be easier to just get the macro to sort Column A first before doing
anything else.

Sorry for the long post. Hope this all makes sense. Any help would be
greatly appreciated!

Thanks!

Joe.
--
If you can measure it, you can improve it!