Conditional row deletion using range comparison?

[jmckeone]

I'm trying to determine how to use VBA to do a conditional row deletion. The sketch below gives you and idea what I want to accomplish. I want to compare the contents of column A on the first sheet to column A on the second sheet and delete rows on the first tab which don't appear on the keep list. Thoughts?

 

[pgc01]

Hi jmckeone

please try:

Sub DelLoc()
Dim lRow As Long, rKeep As Range

Set rKeep = Worksheets("Keep").Range("A2", Worksheets("Keep").Range("A2").End(xlDown))
With Worksheets("Loc")
    For lRow = .Range("A2").End(xlDown).Row To 2 Step -1
        If rKeep.Find(.Range("A" & lRow), LookIn:=xlWhole) Is Nothing Then .Rows(lRow).Delete
    Next
End With
End Sub

Hope this helps
PGC

 

[jmckeone]

tried running it and it fails ... when I run debug the section highlighted is

If rKeep.Find(.Range("A" & lRow), LookIn:=xlWhole) Is Nothing Then

 

[scu77]

deleted

 

[pgc01]

Hi again

I tried but I could not reproduce your error.

I used eactly the layout you specified. A worksheet named Loc, one named Keep and the values you posted.

It worked just fine.

What you can do is in the line with the error check

- rKeep.address
- lRow

Maybe it will help understanding why the error.

Hope you find the bug
PGC

Book1.xls
	A	B	C	D
1	Location
2	A
3	B
4	C
5	D
6	E
7	F
8	G
9
10
11
Loc

Book1.xls
	A	B	C	D
1	Keep
2	A
3	C
4	E
5
6
7
8
9
10
Keep

 

[jmckeone]

copied code and mirrored tab names precisely as shown and yet obtain the following error

 

[pgc01]

Hi jmckeone

I'm glad that now it works!!!

Cheers
PGC

P. S.

This was the final version, without the error in the Find method:

Sub DelLoc()
Dim lRow As Long, rKeep As Range
Dim rRng As Range

Set rKeep = Worksheets("Keep").Range("A2", Worksheets("Keep").Range("A2").End(xlDown))
With Worksheets("Loc")
    For lRow = .Range("A2").End(xlDown).Row To 2 Step -1
        If rKeep.Find(.Range("A" & lRow), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then .Rows(lRow).Delete
    Next
End With

End Sub

 

[jmckeone]

Ran into some issues trying to make real world application but fortunately with a bit of assistance from my brother who works as a coder I was able to revise the code to that shown below

Sub DelLoc()

Dim lRow As Long, rKeep As Range
Dim rRng As Range
Dim EndRow As Integer

Set rKeep = Worksheets("Keep").Range("A2", Worksheets("Keep").Range("A2").End(xlDown))

EndRow = ActiveSheet.UsedRange.Rows.Count

With Worksheets("Loc")
    For lRow = EndRow To 2 Step -1
        If .Range("A" & lRow) <> "" Then
            If rKeep.Find(.Range("A" & lRow), LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
            .Rows(lRow).Delete
        End If
            End If
    Next
End With

End Sub