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.
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

Open in new window

TEST-1.xls
mato01Asked:
Who is Participating?
 
JPConnect With a Mentor IT DirectorCommented:
If you look at cell A7 & A8 they are the same so since J7 contains "No Constraints" it is deleted, same with A14 & A15. Will B always match for the records you want to remove? In your previous example the values in B were sorted or appeared to be and were not duplicated. Is it possible to sort them before checking the values of J or not?
0
 
carsRSTCommented:
Try this code in place of yours...

Sub HideDupRows()

Dim i
Dim J
Dim RowsA
Dim Val1
Dim Val2


    Application.ScreenUpdating = False
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 = True
End Sub
0
 
JPIT DirectorCommented:
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

Open in new window

0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

 
mato01Author Commented:
This works, except that if A is not a duplicate it deletes the row with "No Constraints" anyway.
0
 
JPIT DirectorCommented:
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.
0
 
mato01Author Commented:
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
0
 
mato01Author Commented:
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
0
 
JPIT DirectorCommented:
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.SortFields.Clear 'Change Sheet1 to Sheet Name
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1:B" & lastrow), _ 'Change Sheet1 to Sheet Name
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.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
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.