mato01
asked on
Delete Rows based on 2 columns
I found this code on this site (I've modified),
If Column A is duplicated, delete only the rows with the word "No Constraint" in Column 13.
See attached file, the rows highlighted are the ones that should be deleted.
If Column A is duplicated, delete only the rows with the word "No Constraint" in Column 13.
See attached file, the rows highlighted are the ones that should be deleted.
Sub DeleteDupRows()
Dim i
Dim J
Dim RowsA
Dim Val1
Dim Val2
Application.ScreenUpdating = False
RowsA = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To RowsA
Val1 = Cells(i, 2)
For J = i + 1 To RowsA
Val2 = Cells(J, 2)
If Val1 = Val2 And Cells(i, 13) = "No Constraints" Then
Rows(J).EntireRow.Delete
End If
Next J
Next i
Application.ScreenUpdating = True
End Sub
TEST-1.xls
See attached code
Sub RemoveDupRows()
Dim i
Dim lastrow
Application.ScreenUpdating = False
lastrow = [b65536].End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
If Cells(i, "J").Value = "No Constraints" Then
Rows(i).Delete
ElseIf Cells(i - 1, "J").Value = "No Constraints" Then
Rows(i - 1).Delete
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
ASKER
This works, except that if A is not a duplicate it deletes the row with "No Constraints" anyway.
When I test it does work as it should when "A" is duplicated. When I tested with your file I go from 15 rows to 13 with only the two highlighted rows being removed. But if I put "No Constraints" in cell "J4" then row 4 will be removed as well. This is as you have asked for because "A4" & "A5" are the same even though "B4 & B5" are different groups. If we need to look at column B as well just let us know.
ASKER
I need both conditions to be true for the row to delete.
1. Cell A needs to be a duplicate entry
2. Cell J needs to havew the word "No Constraint".
What the code is doing in both sets of script is deleteing/hiding every row with the word "No Constraints", regardless of Cell A is a duplicate. See attached. What's in yellow should delete or hide, and rows shaded in green should not delete or hide. If you run the script you will see that it deletes all those rows.
TEST-1-2-.xls
1. Cell A needs to be a duplicate entry
2. Cell J needs to havew the word "No Constraint".
What the code is doing in both sets of script is deleteing/hiding every row with the word "No Constraints", regardless of Cell A is a duplicate. See attached. What's in yellow should delete or hide, and rows shaded in green should not delete or hide. If you run the script you will see that it deletes all those rows.
TEST-1-2-.xls
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Yes. How can I add to below toI sort columns A thru M prior to running the remove dup. If not, I can just run another macro prior to running Sub RemoveDupRows
Sub RemoveDupRows()
Dim i
Dim lastrow
Application.ScreenUpdating = False
lastrow = [b65536].End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
If Cells(i, "J").Value = "No Constraints" Then
Rows(i).Delete
ElseIf Cells(i - 1, "J").Value = "No Constraints" Then
Rows(i - 1).Delete
End If
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub RemoveDupRows()
Dim i
Dim lastrow
Application.ScreenUpdating
lastrow = [b65536].End(xlUp).Row
For i = lastrow To 2 Step -1
If Cells(i, "A").Value = Cells(i - 1, "A").Value Then
If Cells(i, "J").Value = "No Constraints" Then
Rows(i).Delete
ElseIf Cells(i - 1, "J").Value = "No Constraints" Then
Rows(i - 1).Delete
End If
End If
Next i
Application.ScreenUpdating
End Sub
You can add this code to the code above before the For i statement. I did not have time to test this code it was modified from another macro I have. If your sheet is not named Sheet1 then replace the name throughout this code. You can add or remove the number of sort keys easily.
Cells.Select
ActiveWorkbook.Worksheets( "Sheet1"). Sort.SortF ields.Clea r 'Change Sheet1 to Sheet Name
ActiveWorkbook.Worksheets( "Sheet1"). Sort.SortF ields.Add Key:=Range("B1:B" & lastrow), _ 'Change Sheet1 to Sheet Name
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets( "Sheet1"). Sort.SortF ields.Add Key:=Range("A2:A" & lastrow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets( "Sheet1"). Sort
.SetRange Range("A2:M" & lastrow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Cells.Select
ActiveWorkbook.Worksheets(
ActiveWorkbook.Worksheets(
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets(
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(
.SetRange Range("A2:M" & lastrow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sub HideDupRows()
Dim i
Dim J
Dim RowsA
Dim Val1
Dim Val2
Application.ScreenUpdating
RowsA = Cells(Rows.Count, 2).End(xlUp).Row
For i = RowsA To 1 Step -1
Val1 = Cells(i, 2)
For J = RowsA To 1 Step -1
Val2 = Cells(J, 2)
If Val1 = Val2 And Cells(J, 10) = "No Constraints" Then
Rows(J).EntireRow.Hidden = True
End If
Next J
Next i
Application.ScreenUpdating
End Sub