How to compare columns in 2 sheets then delete if no match

[needtoknowasu]

Hello,
1st Sheet "KEY"
2nd sheet "Sheet3"

1) Go through Col E in "Sheet3" (rows can vary in length) don't want to hardcode. Plus headers exist in row 1
2) compare to "KEY" Col A. (no header in this sheet)
3) If no match then delete row in "Sheet3"

How do I go about writing the code?
Just stumped how to go about this.

Thanks,
asu

[mehmetcik]

I assume column F of Sheet 3 is empty

In which case this macro would help.

Sub Test()

LR = Cells(Rows.Count, 5).End(xlUp).Row

    Range("F2:F" & LR).FormulaR1C1 = "=IF(ISNA(MATCH(RC[-1],KEY!C[-5],0)),"""",1)"
    Range("F2:F" & LR).Value = Range("F2:F" & LR).Value

    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("F2:F" & LR), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet3").Sort
        .SetRange Range("E1:F" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
NR = Range("F2:F" & LR).SpecialCells(xlCellTypeBlanks).Row
    Rows(NR & ":" & LR).Delete Shift:=xlUp
    Range("A1").Select
columns(6).clear
End Sub

I added some error checking:-

Sub Test()

LR = Cells(Rows.Count, 5).End(xlUp).Row

    Range("F2:F" & LR).FormulaR1C1 = "=IF(ISNA(MATCH(RC[-1],KEY!C[-5],0)),"""",1)"
    Range("F2:F" & LR).Value = Range("F2:F" & LR).Value

    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("F2:F" & LR), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet3").Sort
        .SetRange Range("E1:F" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
On Error Resume Next
NR = Range("F2:F" & LR).SpecialCells(xlCellTypeBlanks).Row
    If Cells(NR, 6).Value = "" Then Rows(NR & ":" & LR).Delete Shift:=xlUp
On Error GoTo 0
    Columns(6).Clear
    Range("A1").Select
End Sub

[needtoknowasu]

On "Sheet3" Col A-F are occupied with data.

Since code is running through Col E I noticed it cleared contents of Col F.

How do I keep COl F data intact?

Looks like matching & deleting rows is working but need COL F to stay intact.

Thanks,
asu

[mehmetcik]

Sub Test()

LR = Cells(Rows.Count, 5).End(xlUp).Row

    Range("G2:G" & LR).FormulaR1C1 = "=IF(ISNA(MATCH(RC[-2],KEY!C[-6],0)),"""",1)"
    Range("G2:G" & LR).Value = Range("G2:G" & LR).Value

    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add Key:=Range("G2:G" & LR), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet3").Sort
        .SetRange Range("E1:G" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
On Error Resume Next
NR = Range("G2:G" & LR).SpecialCells(xlCellTypeBlanks).Row
    If Cells(NR, 7).Value = "" Then Rows(NR & ":" & LR).Delete Shift:=xlUp
On Error GoTo 0
    Columns(7).Clear
    Range("A1").Select
End Sub

[needtoknowasu]

Thank you so much!!

I changed the [-5] to [-6]

You saved me hours if not days trying to figure this out.

Thanks,
asu

[needtoknowasu]

I just noticed that it was not matching all data.

Is there a way I can attach sample file .xslm without exceeding size? My file exceeds the attachment size 240KB

Thanks,
asu

[jolivanes]

Assumes that Column J in Sheet3 is empty.

Sub Maybe()

Dim lr As Long
lr = Sheets("Key").Cells(Rows.Count, 1).End(xlUp).Row

With Sheets("Sheet3")

    With .Range("E2:E" & .Cells(.Rows.Count, 5).End(xlUp).Row).Offset(, 5)
        .Formula = "=Countif(Key!R1C1:R" & lr & "C1,Sheet3!RC[-5])"
        .Value = .Value
    End With
    
    With .Range("J1:J" & .Cells(.Rows.Count, 10).End(xlUp).Row)
        .AutoFilter 1, 0
        .Offset(1).SpecialCells(12).EntireRow.Delete
    End With
    
    .AutoFilterMode = False
    .Columns("J:J").ClearContents
    
End With

End Sub

If you want to attach a file that is too big, make it smaller!