Option Explicit
Sub RemoveRows()
Dim c, d, e, i As Integer
Dim DudRange As Range
Const MasterName = "C:\Test\EE\Test-Find-and-Delete-Master.xls"
Dim wb
Set DudRange = ActiveSheet.UsedRange
Set wb = Workbooks.Open(Filename:=MasterName, UpdateLinks:=False)
Dim RowsToDelete()
ReDim RowsToDelete(1 To wb.Sheets(1).UsedRange.Rows.Count)
Dim RowCheck
Dim DeletbleRows As String
'Performance
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
For c = wb.Sheets(1).UsedRange.Rows.Count To 1 Step -1
For Each e In wb.Sheets(1).UsedRange.Columns
For Each d In DudRange
If d.Value <> "" And d.Value = wb.Sheets(1).Cells(c, e.Column) Then
RowCheck = True
End If
Next d
Next e
If RowCheck Then
wb.Sheets(1).Rows(c & ":" & c).Delete
RowCheck = False
End If
Next c
'Performance
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
With wb
.Save
.Close
End With
End Sub
|
