Gfrktyl

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.

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

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