HiveBrain v1.2.0
Get Started
← Back to all entries
patternModerate

Macro code that removes excess rows

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
codereviewexcelstackoverflowperformancevba
removesrowsthatexcessmacrocode

Problem

I'm a business student who just started to learn VBA. I am trying to write a macro for a project but only have minimal experience actually stepping into the code.

The macro I have written is to delete all row entries which do not meet my criteria if they contain certain words, including removing those with future month's dates in them, and I'd like for this to update based on the current month. I have found that normally the code runs very quickly, but when I add the last part, which removes those with future dates, the code becomes extremely slow.

Is there a way to speed it up or rewrite it so that it is faster?

Sub Remove_excess_entries()
    Dim lRow As Long
    Dim iCntr As Long
    lRow = 10000
    For iCntr = lRow To 1 Step -1
        If Cells(iCntr, 12).Value = "Mule" Or Cells(iCntr, 11).Value = "*R1*" Or Cells(iCntr, 11).Value = "*R2*" Or Cells(iCntr, 7).Value = "*Mule*" Or Cells(iCntr, 6).Value = "*Unassigned*" Or Cells(iCntr, 12).Value = "PS" Or Cells(iCntr, 7).Value = "Marketing" Or Cells(iCntr, 12).Value = "V1" Or DatePart("m", Cells(iCntr, 16).Value) > DatePart("m", Date) Then
            Rows(iCntr).Delete
        End If
    Next
End Sub

Solution

Here's that conditional, reformatted with line continuations for readability:

If Cells(iCntr, 12).Value = "Mule" _ 
    Or Cells(iCntr, 11).Value = "*R1*" _
    Or Cells(iCntr, 11).Value = "*R2*" _
    Or Cells(iCntr, 7).Value = "*Mule*" _
    Or Cells(iCntr, 6).Value = "*Unassigned*" _
    Or Cells(iCntr, 12).Value = "PS" _
    Or Cells(iCntr, 7).Value = "Marketing" _
    Or Cells(iCntr, 12).Value = "V1" _
    Or DatePart("m", Cells(iCntr, 16).Value) > DatePart("m", Date) _
Then
    Rows(iCntr).Delete
End If


There are a number of problems here:

  • Cells (and Rows) are implicit references to the active sheet; this means you're accessing the active worksheet without explicitly saying so - so if the macro takes a long while to run and the user decides to activate another sheet while it's running, your macro will fail to do what it was written for.



  • You're accessing the active sheet multiple times per row, and doing many checks that you may not need to be doing - if Cells(iCntr,11).Value is "R1", then every single next check is happening even though you already know you want to delete that row.



So how do you make it so that you only validate what needs to be validated, and that you don't access the worksheet more than you need to?

First make sure you specify Option Explicit at the top of the module. Option Explicit forces you to always declare all variables you're using, and that alone can prevent many bugs, since without it VBA will happily compile a typo.

Then make it one single read:

Dim target As Worksheet
Set target = Application.ActiveSheet

Dim rowValues()
Dim i As Long
For i = 10000 To 1 Step -1
    rowValues = target.Range(target.Cells(i, 1), target.Cells(i, 20)).Cells
    If IsUpForDeletion(rowValues) Then target.Rows(i).Delete
Next


Now, in one single worksheet operation, we've got an array that contains the values of columns 1-20 for row i; we call a function that returns a Boolean value when the row is "up for deletion", and so we remove that row when that function returns True.

The question is, what would this function do? Remember, we want it to only check what it needs to, and return as soon as it knows it should be returning True.

There's a little hack involving Select Case True that can help here:

Private Function IsUpForDeletion(ByRef rowValues()) As Boolean

    Dim result As Boolean
    result = True

    Select Case True
        Case rowValues(1, 5) = "*Unassigned*"
        Case rowValues(1, 6) = "*Mule*"
        Case rowValues(1, 6) = "Marketing"
        Case rowValues(1, 10) = "*R1*"
        Case rowValues(1, 10) = "*R2*"
        Case rowValues(1, 11) = "PS"
        Case rowValues(1, 11) = "V1"
        Case IsFutureMonth(rowValues(1, 15))
        Case Else
            result = False
    End Select

    IsUpForDeletion = result

End Function

Private Function IsFutureMonth(ByVal value As String) As Boolean

    If Not IsDate(value) Then
        IsFutureMonth = False
        Exit Function
    End If

    IsFutureMonth = DatePart("m", CDate(value)) > Month(Date)

End Function


VBA will evaluate each Case until it finds a condition that evaluates to True, and then immediately jump out and return. Because we're working with an in-memory 2D array here, and not accessing any cells, this is going to run much faster.

Notice the column indices are off by one - that's because VBA arrays are zero-based by default. If you want to refer to column 11 with an 11, then you could use Option Base 1 at the top of the module, and do this:

Private Function IsUpForDeletion(ByRef rowValues()) As Boolean

    Dim result As Boolean
    result = True

    Select Case True
        Case rowValues(1, 6) = "*Unassigned*"
        Case rowValues(1, 7) = "*Mule*"
        Case rowValues(1, 7) = "Marketing"
        Case rowValues(1, 11) = "*R1*"
        Case rowValues(1, 11) = "*R2*"
        Case rowValues(1, 12) = "PS"
        Case rowValues(1, 12) = "V1"
        Case IsFutureMonth(rowValues(1, 16))
        Case Else
            result = False
    End Select

    IsUpForDeletion = result

End Function


For even faster code, make one single read, and iterate an array instead of iterating a worksheet and making 10000 worksheet reads - this code should run orders of magnitude faster than your original code:

```
Option Base 1

Sub DoSomething()

Dim target As Worksheet
Set target = Application.ActiveSheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim rowValues()
Dim i As Long
rowValues = target.Range(target.Cells(1, 1), target.Cells(10000, 20)).Cells
For i = 10000 To 1 Step -1
If IsUpForDeletion(rowValues, i) Then target.Rows(i).Delete
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Private Function IsUpForDeletion(ByRef rowValues(), ByVal i As Long) As Boolean

Dim result As Boolean
result = True

Code Snippets

If Cells(iCntr, 12).Value = "Mule" _ 
    Or Cells(iCntr, 11).Value = "*R1*" _
    Or Cells(iCntr, 11).Value = "*R2*" _
    Or Cells(iCntr, 7).Value = "*Mule*" _
    Or Cells(iCntr, 6).Value = "*Unassigned*" _
    Or Cells(iCntr, 12).Value = "PS" _
    Or Cells(iCntr, 7).Value = "Marketing" _
    Or Cells(iCntr, 12).Value = "V1" _
    Or DatePart("m", Cells(iCntr, 16).Value) > DatePart("m", Date) _
Then
    Rows(iCntr).Delete
End If
Dim target As Worksheet
Set target = Application.ActiveSheet

Dim rowValues()
Dim i As Long
For i = 10000 To 1 Step -1
    rowValues = target.Range(target.Cells(i, 1), target.Cells(i, 20)).Cells
    If IsUpForDeletion(rowValues) Then target.Rows(i).Delete
Next
Private Function IsUpForDeletion(ByRef rowValues()) As Boolean

    Dim result As Boolean
    result = True

    Select Case True
        Case rowValues(1, 5) = "*Unassigned*"
        Case rowValues(1, 6) = "*Mule*"
        Case rowValues(1, 6) = "Marketing"
        Case rowValues(1, 10) = "*R1*"
        Case rowValues(1, 10) = "*R2*"
        Case rowValues(1, 11) = "PS"
        Case rowValues(1, 11) = "V1"
        Case IsFutureMonth(rowValues(1, 15))
        Case Else
            result = False
    End Select

    IsUpForDeletion = result

End Function

Private Function IsFutureMonth(ByVal value As String) As Boolean

    If Not IsDate(value) Then
        IsFutureMonth = False
        Exit Function
    End If

    IsFutureMonth = DatePart("m", CDate(value)) > Month(Date)

End Function
Private Function IsUpForDeletion(ByRef rowValues()) As Boolean

    Dim result As Boolean
    result = True

    Select Case True
        Case rowValues(1, 6) = "*Unassigned*"
        Case rowValues(1, 7) = "*Mule*"
        Case rowValues(1, 7) = "Marketing"
        Case rowValues(1, 11) = "*R1*"
        Case rowValues(1, 11) = "*R2*"
        Case rowValues(1, 12) = "PS"
        Case rowValues(1, 12) = "V1"
        Case IsFutureMonth(rowValues(1, 16))
        Case Else
            result = False
    End Select

    IsUpForDeletion = result

End Function
Option Base 1

Sub DoSomething()

    Dim target As Worksheet
    Set target = Application.ActiveSheet

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim rowValues()
    Dim i As Long
    rowValues = target.Range(target.Cells(1, 1), target.Cells(10000, 20)).Cells
    For i = 10000 To 1 Step -1
        If IsUpForDeletion(rowValues, i) Then target.Rows(i).Delete
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Private Function IsUpForDeletion(ByRef rowValues(), ByVal i As Long) As Boolean

    Dim result As Boolean
    result = True

    Select Case True
        Case rowValues(i, 6) = "*Unassigned*"
        Case rowValues(i, 7) = "*Mule*"
        Case rowValues(i, 7) = "Marketing"
        Case rowValues(i, 11) = "*R1*"
        Case rowValues(i, 11) = "*R2*"
        Case rowValues(i, 12) = "PS"
        Case rowValues(i, 12) = "V1"
        Case IsFutureMonth(rowValues(i, 16))
        Case Else
            result = False
    End Select

    IsUpForDeletion = result

End Function

Private Function IsFutureMonth(ByVal value As String) As Boolean

    If Not IsDate(value) Then
        IsFutureMonth = False
        Exit Function
    End If

    IsFutureMonth = DatePart("m", CDate(value)) > Month(Date)

End Function

Context

StackExchange Code Review Q#131864, answer score: 11

Revisions (0)

No revisions yet.