CODEWITHSUNDEEP
excelvba
sim08
sim08

Reputation: 23

Specific Macros run quicker

I was wondering if there was any way to make this macros run quicker.

There is over 3500 rows and they are continually added to. Right now it takes about 30 seconds to complete (copied the module below).

I have around 10 other modules working by splitting up the "Main" sheet into specific tabs via a run button. In turn running this macro takes about 75 seconds which is far too long. Is there any way to run this quicker also?

Sub FillColumns()
Dim i, LastRow
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual

LastRow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row
For i = 40 To LastRow 'start row number


If Sheets("Main").Cells(i, "A").Value = "CURLEW C-Curlew Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "COOK-Anasuria allocation" _
Or Sheets("Main").Cells(i, "A").Value = "SCOTER-Shearwater Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "MERGANSER-Shearwater Alloc." _
Or Sheets("Main").Cells(i, "A").Value = "PENGUIN-Brent C Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "STARLING-Shearwater Alloc." _
Or Sheets("Main").Cells(i, "A").Value = "HOWE-Nelson allocation" _
Or Sheets("Main").Cells(i, "A").Value = "ANASURIA-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT ALPHA-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT BRAVO-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Brent" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Flags" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT DELTA-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "U500-St Fergus" _
Or Sheets("Main").Cells(i, "A").Value = "BACTON SEAL-SEAL" _
Or Sheets("Main").Cells(i, "A").Value = "CURLEW-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "GANNET-Central" _
Or Sheets("Main").Cells(i, "A").Value = "GANNET-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "MOSSMORRAN-Plants" _
Or Sheets("Main").Cells(i, "A").Value = "U3000-St Fergus" _
Or Sheets("Main").Cells(i, "A").Value = "NELSON-Forties Oil" _
Or Sheets("Main").Cells(i, "A").Value = "NELSON-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-Forties Oil" _
Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-SEAL" Then
Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 2
Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous
Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous
Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous
Else: Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 56
Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous
Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous
Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous
End If

If Sheets("Main").Cells(i, "A").Value = "CURLEW C-Curlew Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "COOK-Anasuria allocation" _
Or Sheets("Main").Cells(i, "A").Value = "SCOTER-Shearwater Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "MERGANSER-Shearwater Alloc." _
Or Sheets("Main").Cells(i, "A").Value = "PENGUIN-Brent C Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "STARLING-Shearwater Alloc." _
Or Sheets("Main").Cells(i, "A").Value = "HOWE-Nelson allocation" _
Or Sheets("Main").Cells(i, "A").Value = "ANASURIA-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT ALPHA-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT BRAVO-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Brent" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Flags" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT DELTA-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "U500-St Fergus" _
Or Sheets("Main").Cells(i, "A").Value = "BACTON SEAL-SEAL" _
Or Sheets("Main").Cells(i, "A").Value = "CURLEW-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "GANNET-Central" _
Or Sheets("Main").Cells(i, "A").Value = "GANNET-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "MOSSMORRAN-Plants" _
Or Sheets("Main").Cells(i, "A").Value = "U3000-St Fergus" _
Or Sheets("Main").Cells(i, "A").Value = "NELSON-Forties Oil" _
Or Sheets("Main").Cells(i, "A").Value = "NELSON-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-Forties Oil" _
Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-SEAL" Then
Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 2
Sheets("Main").Cells(i, "AA").Borders(xlEdgeRight).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AA").Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AA").Borders(xlEdgeTop).LineStyle = xlContinuous
Else: Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 56
Sheets("Main").Cells(i, "AA").Borders(xlEdgeRight).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AA").Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AA").Borders(xlEdgeTop).LineStyle = xlContinuous

End If

If Sheets("Main").Cells(i, "A").Value = "CURLEW C-Curlew Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "COOK-Anasuria allocation" _
Or Sheets("Main").Cells(i, "A").Value = "SCOTER-Shearwater Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "MERGANSER-Shearwater Alloc." _
Or Sheets("Main").Cells(i, "A").Value = "PENGUIN-Brent C Allocation" _
Or Sheets("Main").Cells(i, "A").Value = "STARLING-Shearwater Alloc." _
Or Sheets("Main").Cells(i, "A").Value = "HOWE-Nelson allocation" _
Or Sheets("Main").Cells(i, "A").Value = "ANASURIA-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT ALPHA-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT BRAVO-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Brent" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT CHARLIE-Flags" _
Or Sheets("Main").Cells(i, "A").Value = "BRENT DELTA-Flags Gas" _
Or Sheets("Main").Cells(i, "A").Value = "U500-St Fergus" _
Or Sheets("Main").Cells(i, "A").Value = "BACTON SEAL-SEAL" _
Or Sheets("Main").Cells(i, "A").Value = "CURLEW-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "GANNET-Central" _
Or Sheets("Main").Cells(i, "A").Value = "GANNET-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "MOSSMORRAN-Plants" _
Or Sheets("Main").Cells(i, "A").Value = "U3000-St Fergus" _
Or Sheets("Main").Cells(i, "A").Value = "NELSON-Forties Oil" _
Or Sheets("Main").Cells(i, "A").Value = "NELSON-Fulmar" _
Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-Forties Oil" _
Or Sheets("Main").Cells(i, "A").Value = "SHEARWATER-SEAL" Then
Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 2
Sheets("Main").Cells(i, "AB").Borders(xlEdgeRight).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AB").Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AB").Borders(xlEdgeTop).LineStyle = xlContinuous
Else: Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 56
Sheets("Main").Cells(i, "AB").Borders(xlEdgeRight).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AB").Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheets("Main").Cells(i, "AB").Borders(xlEdgeTop).LineStyle = xlContinuous
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
End Sub

Upvotes: 0

Views: 94

Answers (5)

L42
L42

Reputation: 19727

As commented, try this:

Sub FillColumns()
    Dim i As Long, LastRow As Long
    Dim phrases
    Dim rng1 As Range, rng2 As Range

    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .Calculation = xlCalculationManual
    End With
    '~~> create an array of phrases
    phrases = Array("CURLEW C-Curlew Allocation", "COOK-Anasuria allocation", _
        "SCOTER-Shearwater Allocation", "MERGANSER-Shearwater Alloc.", _
        "PENGUIN-Brent C Allocation", "STARLING-Shearwater Alloc.", _
        "HOWE-Nelson allocation", "ANASURIA-Fulmar", _
        "BRENT ALPHA-Flags Gas", "BRENT BRAVO-Flags Gas", _
        "BRENT CHARLIE-Brent", "BRENT CHARLIE-Flags", _
        "BRENT DELTA-Flags Gas", "U500-St Fergus", _
        "BACTON SEAL-SEAL", "CURLEW-Fulmar", _
        "GANNET-Central", "GANNET-Fulmar", _
        "MOSSMORRAN-Plants", "U3000-St Fergus", _
        "NELSON-Forties Oil", "NELSON-Fulmar", _
        "SHEARWATER-Forties Oil", "SHEARWATER-SEAL")
    '~~> segregate the range to format using the phrases array
    With Sheets("Main")
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 40 To LastRow
            If Not IsError(Application.Match(.Range("A" & i).Value, phrases, 0)) Then
                If rng1 Is Nothing Then
                    Set rng1 = .Range("Z" & i, "AB" & i)
                Else
                    Set rng1 = Union(rng1, .Range("Z" & i, "AB" & i))
                End If
            Else
                If rng2 Is Nothing Then
                    Set rng2 = .Range("Z" & i, "AB" & i)
                Else
                    Set rng2 = Union(rng2, .Range("Z" & i, "AB" & i))
                End If
            End If
        Next
    End With
    '~~> format the ranges in one go
    With rng1
        .Interior.ColorIndex = 2
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With
    With rng2
        .Interior.ColorIndex = 56
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayStatusBar = True
        .ScreenUpdating = True
    End With
End Sub

HTH. I've commented the important parts.
If something is unclear, just comment it out.

Upvotes: 1

user3708287
user3708287

Reputation: 1

Before running your macro delete empty rows from excel sheet. You can find empty rows by Cntrl+End. Press control+end, delete empty rows and save your sheet and then run macro. This will help you to run your macro fast as well as reduce the size too,

Upvotes: 0

user2271770
user2271770

Reputation:

Improvement #1. The Or operator in VBA is eager, meaning that it will evaluate all the terms, even it could stop at the first that is True -- there's a first waste in your execution time. So, instead of If expr1 Or expr2 Or ... Or exprn you might want to use the equivalent form of Select Case, that will lazily evaluate its branching. For example, your first If will be transformed as:

Select Case Sheets("Main").Cells(i, "A").Value
Case "COOK-Anasuria allocation", "SCOTER-Shearwater Allocation", _
     "MERGANSER-Shearwater Alloc.", "PENGUIN-Brent C Allocation", _
     "STARLING-Shearwater Alloc.", "HOWE-Nelson allocation", _
     "ANASURIA-Fulmar", "BRENT ALPHA-Flags Gas", _
     "BRENT BRAVO-Flags Gas", "BRENT CHARLIE-Brent", _
     "BRENT CHARLIE-Flags", "BRENT DELTA-Flags Gas", _
     "U500-St Fergus", "BACTON SEAL-SEAL", _
     "CURLEW-Fulmar", "GANNET-Central", _
     "GANNET-Fulmar", "MOSSMORRAN-Plants", _
     "U3000-St Fergus", "NELSON-Forties Oil", _
     "NELSON-Fulmar", "SHEARWATER-Forties Oil", _
     "SHEARWATER-SEAL"
          Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 2
          Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous
          Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous
          Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous
          Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous
Case Else
          Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 56
          Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous
          Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous
          Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous
         Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous
End Select

Improvement #2. If you have some insight in how often the tested strings appear, you can use that info to shorten your execution time. The Select statement will test sequentially its Cases, then inside the Case branch its expressions; if you put the strings with biggest occurrence probability at the beginning of your Select statement, or at the beginning of your Case branch, you'll save useless comparisons.

Improvement #3. The answer of VBlades

Upvotes: 3

Juliusz
Juliusz

Reputation: 2105

  1. Use only one IF statement - you have three checking for the same logic. The IF logic is complicated, so there is no point in replicating it.

  2. Assign Sheets("Main").Cells(i, "A").Value to a string variable and use this variable in the code. I believe that each time you refer to Sheets("Main").Cells(i, "A").Value the engine goes through the path Workbook->Sheet->Cell->Value. I don't know how good the optimiser is.

    Dim sValue as String: sValue = Sheets("Main").Cells(i, "A").Value

  3. When you do formatting - use With, so you speed up the referencing:

    With Sheets("Main").Cells(i, "AB") .Interior.ColorIndex = 56 .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeTop).LineStyle = xlContinuous End With

Upvotes: 0

VBlades
VBlades

Reputation: 2251

You have three If blocks checking for the same condition it seems. I've consolidated it here. Replace those three with this:

EDIT 2: I've actually pulled out what I had and replaced the whole subroutine. I'm replacing references to current cell in A with a string variable. Not sure how much extra time it adds, but I'm sure the resolving of the cell reference is overhead. Might as well read it once and just store it. Sill not sure if the string comparisons themselves can be done faster.

Sub FillColumns()

    Dim i, LastRow
    Dim strCellA As String

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual

    LastRow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row

    For i = 40 To LastRow 'start row number
        strCellA = Sheets("Main").Cells(i, "A").Value

        If  strCellA = "CURLEW C-Curlew Allocation" _
            Or strCellA = "COOK-Anasuria allocation" _
            Or strCellA = "SCOTER-Shearwater Allocation" _
            Or strCellA = "MERGANSER-Shearwater Alloc." _
            Or strCellA = "PENGUIN-Brent C Allocation" _
            Or strCellA = "STARLING-Shearwater Alloc." _
            Or strCellA = "HOWE-Nelson allocation" _
            Or strCellA = "ANASURIA-Fulmar" _
            Or strCellA = "BRENT ALPHA-Flags Gas" _
            Or strCellA = "BRENT BRAVO-Flags Gas" _
            Or strCellA = "BRENT CHARLIE-Brent" _
            Or strCellA = "BRENT CHARLIE-Flags" _
            Or strCellA = "BRENT DELTA-Flags Gas" _
            Or strCellA = "U500-St Fergus" _
            Or strCellA = "BACTON SEAL-SEAL" _
            Or strCellA = "CURLEW-Fulmar" _
            Or strCellA = "GANNET-Central" _
            Or strCellA = "GANNET-Fulmar" _
            Or strCellA = "MOSSMORRAN-Plants" _
            Or strCellA = "U3000-St Fergus" _
            Or strCellA = "NELSON-Forties Oil" _
            Or strCellA = "NELSON-Fulmar" _
            Or strCellA = "SHEARWATER-Forties Oil" _
            Or strCellA = "SHEARWATER-SEAL" Then
                Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 2
                Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 2
                Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 2
        Else:   Sheets("Main").Cells(i, "Z").Interior.ColorIndex = 56
                Sheets("Main").Cells(i, "AA").Interior.ColorIndex = 56
                Sheets("Main").Cells(i, "AB").Interior.ColorIndex = 56
        End If

        Sheets("Main").Cells(i, "Z").Borders(xlEdgeLeft).LineStyle = xlContinuous
        Sheets("Main").Cells(i, "Z").Borders(xlEdgeRight).LineStyle = xlContinuous
        Sheets("Main").Cells(i, "Z").Borders(xlEdgeBottom).LineStyle = xlContinuous
        Sheets("Main").Cells(i, "Z").Borders(xlEdgeTop).LineStyle = xlContinuous


        Sheets("Main").Cells(i, "AA").Borders(xlEdgeRight).LineStyle = xlContinuous
        Sheets("Main").Cells(i, "AA").Borders(xlEdgeBottom).LineStyle = xlContinuous
        Sheets("Main").Cells(i, "AA").Borders(xlEdgeTop).LineStyle = xlContinuous

        Sheets("Main").Cells(i, "AB").Borders(xlEdgeRight).LineStyle = xlContinuous
        Sheets("Main").Cells(i, "AB").Borders(xlEdgeBottom).LineStyle = xlContinuous
        Sheets("Main").Cells(i, "AB").Borders(xlEdgeTop).LineStyle = xlContinuous
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True
End Sub

This already should be much faster. There's probably a faster way to do the string comparisons as well. Let me think about it.

EDIT 1: Just looking at the code, I pulled all the stuff that was similar in both branches out so that will always run.

Upvotes: -1

Related Questions