Remove entire row based on match?

落爺英雄遲暮 提交于 2019-12-02 12:26:05

This will work, very fast for what you are looking to do as it doesn't involve ANY loops.

Sub DeleteDuplicates()

Dim StartingScreenUpdateValue As Boolean
Dim StartingEventsValue As Boolean
Dim StartingCalculations As XlCalculation

With Application
    StartingScreenUpdateValue = .ScreenUpdating
    StartingEventsValue = .EnableEvents
    StartingCalculations = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With


Dim varTestValues As Variant
Dim sh1 As Worksheet
Dim sh2 As Worksheet

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")

With sh2
    varTestValues = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
End With

sh1.Range("L1", sh1.Range("L" & sh1.Rows.Count).End(xlUp)) _
    .AutoFilter Field:=12, Criteria1:=Application.Transpose(varTestValues), Operator:=xlFilterValues

sh1.Range("L2", sh1.Range("L" & sh1.Rows.Count).End(xlUp)) _
    .SpecialCells(xlCellTypeVisible).EntireRow.Delete

sh1.AutoFilterMode = False

With Application
    .ScreenUpdating = StartingScreenUpdateValue
    .EnableEvents = StartingEventsValue
    .Calculation = StartingCalculations
End With

End Sub

NOTE: This code runs assuming your data has headers if it does not please advise.

REMEMBER Always run any code on a copy of your data and not your actual data until you are confident that it is working 100%.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!