Mikz
Mikz

Reputation: 591

Comparing two sheets and deleting the entire row

I have two sheets , Sheet1 and sheet2 .

Sheet 1 is my Source sheet and I am mentioning the item number in column A.

Sheet 2 is my destination sheet the contains the list of item number from the data base.

I am comparing the column A of source sheet with column E of my destination sheet, if they both have same item number then I am deleting the entire row.

I am using the below code for this. on 6 item number 4 are getting deleted and 2 are not getting deleted.

But, when I copy the same item number from the destination sheet to source sheet ,then it is getting deleted. I am not sure why this is happening. Could any one guide how I could figure this out.

below is the code

Sub spldel()

Dim srcLastRow As Long, destLastRow As Long
Dim srcWS As Worksheet, destWS As Worksheet
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set srcWS = ThisWorkbook.Sheets("sheet1")
Set destWS = ThisWorkbook.Sheets("sheet2")
srcLastRow = srcWS.Cells(srcWS.Rows.count, "A").End(xlUp).Row
destLastRow = destWS.Cells(destWS.Rows.count, "E").End(xlUp).Row
For i = 5 To destLastRow - 1
For j = 1 To srcLastRow

' compare column E of both the sheets
If destWS.Cells(i, "E").Value = srcWS.Cells(j, "A").Value Then

destWS.Cells(i, "E").EntireRow.delete
End If
Next j
Next i
End Sub

Upvotes: 1

Views: 143

Answers (2)

Zac
Zac

Reputation: 1944

Here is another approach:

Rather than looping through each item everytime in your source and destination sheets, just use MATCH function:

Function testThis()

    Dim destWS As Worksheet: Set destWS = ThisWorkbook.Worksheets("Sheet8")     ' Change to your source sheet
    Dim srcWS As Worksheet: Set srcWS = ThisWorkbook.Worksheets("Sheet12")      ' Change to your destination sheet
    Dim iLR As Long: iLR = srcWS.Range("L" & srcWS.Rows.count).End(xlUp).Row    ' Make sure you change the column to get the last row from
    Dim iC As Long
    Dim lRetVal As Long

    On Error Resume Next
    For iC = 1 To iLR
        lRetVal = Application.WorksheetFunction.Match(srcWS.Range("L" & iC), destWS.Range("A:A"), 0)
        If Err.Number = 0 Then
            destWS.Range("A" & lRetVal).EntireRow.Delete
        End If
        Err.Clear
    Next
    On Error GoTo 0

End Function

Upvotes: 1

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Remember to loop in reverse order when you are trying to delete the rows otherwise rows may skipped from deletion even when they qualify the deletion criteria.

So the two For loops should be like this....

For i = destLastRow - 1 To 5 Step -1
For j = srcLastRow To 1 Step -1

Upvotes: 3

Related Questions