CODEWITHSUNDEEP
vbaexcel
Nikolajs
Nikolajs

Reputation: 335

Optimizing VBA Program

I created several VBA functions and macros to automate my work, but as more data goes in, I'm noticing a larger delay in running my macros. Are there any things that I can change or alter in my code to improve its efficiency?

Premise of the program: - Refresh button loops through all worksheets, changes colors based on their completion, and puts information of "Incomplete/Expired" forms in a table (slowest)

'===============
'Refresh Button on MASTER PAGE
'Functions: Updates color of sheets, based on completion/incompletion
'           Removes inputs from MASTER page
'           Updates Expired Forms cells
'====================
Sub refresh_form()
Dim ws As Worksheet
Dim wb As Workbook
Dim wsMASTER, wsTEMP
Dim complete, incomplete, exp, default   'to store color index's
Dim expName, expDate, expGSA, expStatus  'to store values for expired forms
Dim lastRow As Long                      'to store row # for expired & incomplete form

'CLEARS DATA FROM MAIN SHEET
ThisWorkbook.Worksheets("MASTER").Range("C6").Value = ""    'Project name
ThisWorkbook.Worksheets("MASTER").Range("C7").Value = ""    'Address
ThisWorkbook.Worksheets("MASTER").Range("C8").Value = ""    'Date
ThisWorkbook.Worksheets("MASTER").Range("C9").Value = ""    'GSA #
ThisWorkbook.Worksheets("MASTER").Range("C10").Value = ""   'Exp Date

wsMASTER = "MASTER"             'Sets wsMASTER as MASTER worksheet
wsTEMP = "TEMPLATE"             'Sets wsTEMP as TEMPLATE worksheet

complete = 4        'Green
incomplete = 44     'Orange
default = 2         'White
exp = 3             'Red

lastRow = 5        'Expired & Incomplete row starts at 5

For Each ws In ThisWorkbook.Worksheets                                                'Loops through all worksheets on click
    If ws.Name = wsMASTER Or ws.Name = wsTEMP Then                                      'For MASTER and TEMPLATE sheet, skip
        ws.Tab.ColorIndex = default
    ElseIf ws.Range("$M12").Value = True And ws.Range("$M$15").Value = True Then        'Applies "Exp" tab color to expired/incomp forms
        ws.Tab.ColorIndex = exp
        expName = ws.Range("$C$5").Value    'Stores current form's project name
        expDate = ws.Range("$C$9").Value    '***expiration date
        expGSA = ws.Range("$C$8").Value     '***GSA number
        lastRow = lastRow + 1               'increments lastRow by a value of 1
                                                                                        'VALUES INPUTTED IN EXPIRED & INCOMPLETE FORM
        ThisWorkbook.Worksheets("MASTER").Range("K" & lastRow).Value = expGSA           '       GSA #
        ThisWorkbook.Worksheets("MASTER").Range("L" & lastRow).Value = expName          '       Project name
        ThisWorkbook.Worksheets("MASTER").Range("M" & lastRow).Value = expDate          '       Expiration date

    ElseIf ws.Range("$M$12").Value = True Then                                          'Applies "Incomplete" tab color to incomplete forms
        ws.Tab.ColorIndex = incomplete
    ElseIf ws.Range("$M$12").Value = False And ws.Range("$N$12").Value = True Then      'Applies "Complete" tab color to complete forms
        ws.Tab.ColorIndex = complete
    Else                                                                                'Applies "Default" tab color to any untouched forms
        ws.Tab.ColorIndex = default
    End If
Next ws                                                                               'End Loop

End Sub                                                                                   'End Sub

Upvotes: 0

Views: 399

Answers (3)

Xabier
Xabier

Reputation: 7735

This question is probably best answered at Code Review, but a simple way to increase performance would be to do something like below:

'===============
'Refresh Button on MASTER PAGE
'Functions: Updates color of sheets, based on completion/incompletion
'           Removes inputs from MASTER page
'           Updates Expired Forms cells
'====================
Sub refresh_form()
Dim ws As Worksheet
Dim wsMaster As Worksheet: Set wsMaster = Worksheets("MASTER")
Dim wb As Workbook
Dim wsTEMP As String
Dim complete As Integer, incomplete As Integer, exp As Integer, default As Integer       'to store color index's
Dim lastRow As Long                      'to store row # for expired & incomplete form

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'CLEARS DATA FROM MAIN SHEET
 wsMaster.Range("C6:C10").ClearContents

complete = 4        'Green
incomplete = 44     'Orange
default = 2         'White
exp = 3             'Red
lastRow = 5        'Expired & Incomplete row starts at 5

For Each ws In ThisWorkbook.Worksheets                                                'Loops through all worksheets on click
    If ws.Name = wsMaster.Name Or ws.Name = "TEMPLATE" Then                           'For MASTER and TEMPLATE sheet, skip
        ws.Tab.ColorIndex = default
    ElseIf ws.Range("$M12").Value = True And ws.Range("$M$15").Value = True Then      'Applies "Exp" tab color to expired/incomp forms
        ws.Tab.ColorIndex = exp
        lastRow = lastRow + 1                                                         'increments lastRow by a value of 1
        wsMaster.Range("K" & lastRow).Value = ws.Range("$C$8").Value                  'GSA #
        wsMaster.Range("L" & lastRow).Value = ws.Range("$C$5").Value                  'Project name
        wsMaster.Range("M" & lastRow).Value = ws.Range("$C$9").Value                  'Expiration date
    ElseIf ws.Range("$M$12").Value = True Then                                        'Applies "Incomplete" tab color to incomplete forms
        ws.Tab.ColorIndex = incomplete
    ElseIf ws.Range("$M$12").Value = False And ws.Range("$N$12").Value = True Then    'Applies "Complete" tab color to complete forms
        ws.Tab.ColorIndex = complete
    Else                                                                              'Applies "Default" tab color to any untouched forms
        ws.Tab.ColorIndex = default
    End If
Next ws                                                                               'End Loop

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

Upvotes: 4

Adam Vincent
Adam Vincent

Reputation: 3811

The majority of your macro is not doing anything extremely intensive. The most intensive operation Excel is doing is updating the UI when it switches between worksheets. You may see a significant improvement if you temporarily disable UI updating.

Before you enter your For Each loop, call Application.ScreenUpdating = False

And before your Sub Routine exits, restore screen updating Application.ScreenUpdating = True

There is not a lot else you can do to improve the performance of the code. Other optimization options would be to keep the number of Worksheets to a minimum, or using multiple Workbooks.

Upvotes: 1

Jodrey
Jodrey

Reputation: 11

Add this to the beginning of your code below your DIMs

Application.calculation=xlcalculationmanual
application.screenupdating=false
application.displaystatusbar=false
application.enableevents=false

then add this at the end of your code before end sub

Application.calculation=xlcalculationautomatic
application.screenupdating=true
application.displaystatusbar=true
application.enableevents=true

This should help speed up your code.

Upvotes: 1

Related Questions