# Macro to remove rows with data not meeting certain requirements

I have created several macros that delete rows based on cell values. I run it 5 times for different data, but think there should be a way to combine them and speed up the macro. Currently, it is running a little slow.

It is pulling a date from another worksheet and if it doesn't match, removing the line. I am basically running the same macro over and over, just changing the values slightly.

I am just changing the value in column E (120 in this example, but could be 30, 60, 90, etc) and seeing if it matches the date on another worksheet. The cell on the other worksheet changes depending on E value If 30, use date A1 If 60, use date in A2 etc.

Here is one of the five macros I have:

Sub Remove_FutureRenewals_120()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

Firstrow = ThisWorkbook.Worksheets(2).UsedRange.Cells(1).Row
LastRow = ThisWorkbook.Worksheets(2).Cells(ThisWorkbook.Worksheets(2).Rows.Count, "A").End(xlUp).Row

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
'.ScreenUpdating = False
End With

With ActiveSheet
For Lrow = LastRow To Firstrow Step -1
With .Cells(Lrow, "E")
If Not IsError(.Value) Then
If .Value = "120" _
And Format(.Offset(0, -1).Value, "YYYYMMDD") <> Format(ThisWorkbook.Worksheets("Date Calc").Cells(5, "A").Value, "YYYYMMDD") _
Then .EntireRow.Delete
End If
End With

Next Lrow

End With

End Sub


An interesting learning experience.

Well done for doing the deletion in a backwards loop. Also, well done for declaring all variables.

As you have implied, there is room for some improvement. What I suggest below may not increase speed, but should at least help with maintainability and readability.

## Three different ways of accessing a sheet

You are using three different ways of accessing a sheet: index, ActiveSheet and name. Each has their uses and are valid, but mixing methods in a single routine makes it a little more confusing to read.

You haven't identified how the routine is called, and this makes a difference on the applicability of ActiveSheet. How can you guarantee that the active sheet is the one that you want to clean up?

You also reference your FirstRow and LastRow from a fixed sheet, not your ActiveSheet - how can you be sure that they are correct?

## Speed up routine

You set your calculation mode and attempted to turn off screen updating. But you don't turn them back again at the end of the routine.

Also consider setting .EnableEvents = False so that you do not fire events every time you delete a row.

## Tweaks

Consider using a Select Case to identify a valid row. I have an example in the code below.

Consider creating a Union for each row that you find and want to delete. Then use this union to delete all the rows at once, instead of one at a time.

Put your date value into a variable, rather than accessing the cell each time in the loop. This will save some time and accessing the Excel cells/ranges is relatively expensive.

## Perhaps this code?

Sub Remove_FutureRenewals()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim SelectedSheet as Worksheet
Dim BaseDate as String

Set SelectedSheet = ActiveSheet ' addresses any change to ActiveSheet while routine is running.
BaseDate = Format(ThisWorkbook.Worksheets("Date Calc").Cells(5, "A").Value, "YYYYMMDD")

Firstrow = SelectedSheet.UsedRange.Cells(1).Row
LastRow = SelectedSheet.Cells(ThisWorkbook.Worksheets(2).Rows.Count, "A").End(xlUp).Row

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

With SelectedSheet
For Lrow = LastRow To Firstrow Step -1
Select Case .Cells(Lrow, "E").Value ' always be explicit.
Case "120", "90", "60" 'etc
'If Format(.Cells(Lrow, "E").Offset(0, -1).Value, "YYYYMMDD") <> BaseDate Then
If Format(.Cells(Lrow, "D").Value, "YYYYMMDD") <> BaseDate Then
.EntireRow.Delete
End If ' Better practice to use a full If-The-Endif block rather than a single line
End Select
Next Lrow
End With
With Application
.Calculation = CalcMode
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub


This code still has a lot of "magic numbers" in it, but should give you some ideas on where to go next.

## Firstrow and LastRow

Firstrow and LastRow refer to cells on ThisWorkbook.Worksheets(2) but are used to iterate over the cells of the ActiveSheet. I'm guessing that ThisWorkbook.Worksheets(2) is the original data that is being copied to a new worksheet for processing. In any case, it would be better to have them refer to the same worksheet. After all you are reducing the number of rows 5 times.

Firstrow = ThisWorkbook.Worksheets(2).UsedRange.Cells(1).Row
LastRow = ThisWorkbook.Worksheets(2).Cells(ThisWorkbook.Worksheets(2).Rows.Count, "A").End(xlUp).Row

With ActiveSheet
For Lrow = LastRow To Firstrow Step -1


## Repeat Code

There are 5 procedures that basically do the same thing. Extracting the repeated code into its own subroutine and passing in the variable information will make the code easier to read, modify and debug.

Sub Remove_FutureRenewals(ws As Worksheet, EValue As Variant, CalcDate As Date)


Note: The eValue parameter is meant to tests the values in Column e. It is typed as Long because all the values (30, 60, 90, 120) are integer values. If this is the case then .Value = "120" should be .Value = 120. Using a string for a number should be avoided.

## Keep Formatting

If you want to preserve formatting then it would be best to Union() all the rows to be deleted and delete them all at once.

Sub Remove_FutureRenewals(ws As Worksheet, EValue As Variant, CalcDate As Date)
Dim cell As Range, target As Range

CalcDate = DateValue(CalcDate)

With ws
For Each cell In .Range("E1", .Cells(.Rows.Count, "E").End(xlUp))
With cell
If Not IsError(.Value) And IsDate(.Offset(0, -1).Value) Then
If .Value = EValue And DateValue(.Offset(0, -1).Value) <> CalcDate Then
If target Is Nothing Then
Set target = .EntireRow
Else
Set target = Union(target, .EntireRow)
End If
End If
End If
End With
Next
End With

If Not target Is Nothing Then
Dim CalcMode As XlCalculation
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False

target.Delete

.Calculation = CalcMode
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub


## Values Only

When working with values it is much faster to use arrays then it is to delete multiple rows.

Here is the pattern that I use: - Define a target Range. In this case I just used the UsedRange - Load the target.Value into a variant called data. data = target.Value - Make a second array named results the same size as the data array - Iterate over the data array adding any rows to be kept to the results array - Write the results over the original target range

Sub Remove_FutureRenewals2(ws As Worksheet, EValue As Variant, CalcDate As Date)
CalcDate = DateValue(CalcDate)
Dim data As Variant, results As Variant
data = ws.UsedRange.Value

ReDim results(1 To UBound(data), 1 To UBound(data, 2))

Dim r As Long, c As Long, resultsRow As Long

For r = 1 To UBound(data)
If data(r, 5) = EValue And DateValue(data(r, 4)) = CalcDate Then
resultsRow = resultsRow + 1

For c = 1 To UBound(data, 2)
results(resultsRow, c) = data(r, c)
Next

End If

Next

Application.ScreenUpdating = False
ws.UsedRange.Value = results

End Sub


I would not run the Delete until after the end of your procedure. Create a range using Union and then run the delete at the end.

Dim DeleteRNG As Range

'Do this First so you don't have to keep if-statements checking throughout the loop.
Set DeleteRNG = Cells(Rows.Count, 1)

'Then Run your loops and check

If .Value = "120" _
And Format(.Offset(0, -1).Value, "YYYYMMDD") <> Format(ThisWorkbook.Worksheets("Date Calc").Cells(5, "A").Value, "YYYYMMDD") _
Then
Set DeleteRNG = Union(.EntireRow, DeleteRNG)
End If

'then after all looops

DeleteRNG.EntireRow.Delete