Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify a macro for deleting rows based on two or more colu
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! |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify a macro for deleting rows based on two or more colu
it appears to do what you want here, but i don't have your dataset.
anyway, i would qualify all of the ranges and use .value for the cell references. i usually do my if's on different lines so it's easier for me read and to create breakpoints Sub DeleteDuplicates2Columns() Dim LR As Long, i As Long Dim ws As Worksheet Application.ScreenUpdating = False Set ws = Worksheets("Sheet1") LR = Range("A" & Rows.Count).End(xlUp).Row For i = LR To 2 Step -1 If ws.Cells(i, "A").Value = ws.Cells(i - 1, "A").Value And ws.Cells(i, "L").Value = ws.Cells(i - 1, _ "L").Value Then ws.Rows(i).EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub -- Gary Keramidas Excel 2003 "Monomeeth" wrote in message ... 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! |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify a macro for deleting rows based on two or more colu
and watch for wordwrap, too. one line split. the following will split, but it
goes on one line If ws.Cells(i, "A").Value = ws.Cells(i - 1, "A").Value And ws.Cells(i, "L").Value = ws.Cells(i - 1, _ -- Gary Keramidas Excel 2003 "Gary Keramidas" <GKeramidasAtMSN.com wrote in message ... it appears to do what you want here, but i don't have your dataset. anyway, i would qualify all of the ranges and use .value for the cell references. i usually do my if's on different lines so it's easier for me read and to create breakpoints Sub DeleteDuplicates2Columns() Dim LR As Long, i As Long Dim ws As Worksheet Application.ScreenUpdating = False Set ws = Worksheets("Sheet1") LR = Range("A" & Rows.Count).End(xlUp).Row For i = LR To 2 Step -1 If ws.Cells(i, "A").Value = ws.Cells(i - 1, "A").Value And ws.Cells(i, "L").Value = ws.Cells(i - 1, _ "L").Value Then ws.Rows(i).EntireRow.Delete End If Next Application.ScreenUpdating = True End Sub -- Gary Keramidas Excel 2003 "Monomeeth" wrote in message ... 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! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify a macro for deleting rows based on two or more colu
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 -- joel ------------------------------------------------------------------------ joel's Profile: 229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=171629 Microsoft Office Help |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help to modify a macro for deleting rows based on two or more colu
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Deleting Rows with a macro based on a date value | Excel Worksheet Functions | |||
modify macro to execute based on current path | Excel Programming | |||
Chart changing based on change in data source (number of rows/colu | Charts and Charting in Excel | |||
Can you hide and unhide rows with a macro based on content of colu | Excel Programming | |||
Deleting rows based on data NOT meeting criteria --working macro here, just need help with tweaking | Excel Programming |