VBA code to look in multiple sheets, multiple columns, delete rows from one sheet

[loddydoddy81]

I have the below code that is set to look at sheet1 Column A for Last Name. It then references sheet2 Column B. If it finds that Last Name, it deletes all rows with that last name.
The problem is that sometimes with my data, I have people with the same last name. So if I leave it as is, it will delete everyone with that last name, which I don't want.
What I need is to further add on to this code and have it look if the Column A in sheet1 has a matching last name per Column B of sheet2, it then looks in Column B of sheet1 for the First Name and then looks in Column C of sheet2 and if it IS a match it deletes. If it is NOT a match it keeps it.

For example if I have
sheet1
A B
Smith John
Smith Frank

and sheet2 has
B C
Smith John

It will leave Smith Frank and delete all rows with Smith John

With Sheets("sheet1")
lr = .Range("A" & Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1
If IsNumeric(Application.Match(.Range("A" & i).Value, Sheets("sheet2").Columns("B"), 0)) Then .Rows(i).Delete
Next i
End With

 

[jolivanes]

Re: "and if it IS a match it deletes."
In Sheet1 or Sheet2

 

[jolivanes]

Try on a copy of your original.
It assumes headers in both sheets.
This colors the same names red in Sheet2. Run the code and see if it does what you expect.
If it does as advertised, change the ".Interior.Color = vbRed" to ".Delete Shift:=xlUp"

Sub Maybe()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long
Dim sh1Arr, sh2Arr
Dim lr1 As Long, lr2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 2).End(xlUp).Row
sh1Arr = sh1.Range("A2:B" & lr1).Value
sh2Arr = sh2.Range("B2:C" & lr2).Value
    For i = LBound(sh2Arr) To UBound(sh2Arr)
        For j = LBound(sh1Arr) To UBound(sh1Arr)
            If sh1Arr(j, 1) = sh2Arr(i, 1) And sh1Arr(j, 2) = sh2Arr(i, 2) Then sh2.Cells(i + 1, 2).Resize(, 2).Interior.Color = vbRed
        Next j
    Next i
End Sub

 

[loddydoddy81]

Re: "and if it IS a match it deletes."
In Sheet1 or Sheet2

In sheet1

 

[loddydoddy81]

Try on a copy of your original.
It assumes headers in both sheets.
This colors the same names red in Sheet2. Run the code and see if it does what you expect.
If it does as advertised, change the ".Interior.Color = vbRed" to ".Delete Shift:=xlUp"

Sub Maybe()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long
Dim sh1Arr, sh2Arr
Dim lr1 As Long, lr2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 2).End(xlUp).Row
sh1Arr = sh1.Range("A2:B" & lr1).Value
sh2Arr = sh2.Range("B2:C" & lr2).Value
    For i = LBound(sh2Arr) To UBound(sh2Arr)
        For j = LBound(sh1Arr) To UBound(sh1Arr)
            If sh1Arr(j, 1) = sh2Arr(i, 1) And sh1Arr(j, 2) = sh2Arr(i, 2) Then sh2.Cells(i + 1, 2).Resize(, 2).Interior.Color = vbRed
        Next j
    Next i
End Sub

So it works but doesn't work....when i have the code as you originally posted it, it does highlight the test person's name red in sheet2 and does not delete them from sheet1.
But, once i change the last bit to ".Delete Shift:=xlUp", it does not delete the test person's name from sheet1. Also, on sheet2, it deletes some but not all the last names of other people that it should not be deleting (as they don't have a duplicate or a first name in column C or anything).
And oddly, when i have it with just the old code of mine or delete it and add in your code as you posted it, it takes about 1-2 minutes to do everything. When i change to the Delete Shift, for some reason it takes like 15 minutes. Not sure what is up with that...?

 

[jolivanes]

Don't quote. Makes it harder to follow (read through all posts) and just extra clutter.
Refer to Post numbers if required or quote just that part that makes your request understandable.

Try on a copy of your original first as it deletes the cells in question.
No going back (Undo).

Sub Maybe_2()
Dim sh1 As Worksheet, sh2 As Worksheet, i As Long, j As Long
Dim sh1Arr, sh2Arr
Dim lr1 As Long, lr2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 2).End(xlUp).Row
sh1Arr = sh1.Range("A2:B" & lr1).Value
sh2Arr = sh2.Range("B2:C" & lr2).Value
Application.ScreenUpdating = False
    For i = LBound(sh2Arr) To UBound(sh2Arr)
        For j = UBound(sh1Arr) To LBound(sh1Arr) Step -1
            If sh1Arr(j, 1) = sh2Arr(i, 1) And sh1Arr(j, 2) = sh2Arr(i, 2) Then sh1.Cells(j + 1, 1).Resize(, 2).Delete Shift:=xlUp
        Next j
        sh1Arr = sh1.Range("A2:B" & sh1.Cells(Rows.Count, 1).End(xlUp).Row).Value
    Next i
Application.ScreenUpdating = True
End Sub

 

[loddydoddy81]

Looks like that worked. Thank you so much!

 

[jolivanes]

Thanks for letting us know and good luck.

 

[loddydoddy81]

Ok, so I was wrong, I am sorry. It is working, however i'm not sure if this issue I am having is due to other code. It gives me an error that says "Compile error: Duplicate declaration in current scope".
And the debug box shows "i As Long," highlighted. I don't quite understand what that means. I do have that elsewhere in my code, but not sure why it's giving that error. If I delete the "i As Long" it works with no error.
But, it then messes up the information about 3/4 of the way down for column C in Sheet 1. And leaves a few rows/columns gap and then has information in it that should have sorted upwards. Almost as if the code doesn't quite look down enough rows.

 

[jolivanes]

If you change the code things like that can happen.