Disabling Screen Updating function is slowing down my macro

Martunis99

New Member
Joined
Aug 16, 2021
Messages
19
Office Version
  1. 2016
Platform
  1. Windows
Hi guys,

So I built a macro that copies some contents of files to one single sheet based on some cell values.
Since some of these files are extracted from a separate program that executes a few runs on different populations, the amount of data to be copied can sometimes amount to several thousand rows.

In an attempt to make the macro run faster, I put Application.ScreenUpdating = False in the beginning of my program and turned it back on again in the end.
However, when I disable screen updating the macro takes up to 3min to copy over 4 files, and when I don't disable screen updating the macro takes only 30sec to copy the exact same files.

Do you have any idea why in this instance disabling screen updating is actually making my macro slower?

(PS: I don't have any Select or Activates as advised and I tried to assign all my ranges to variables)

Thank you!
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
I have never heard of or experienced such behavior. I see no reason why it would slow your code down.
I have a feeling that there is more going on here that is affecting it.
Your best bet would be to post your whole code so that people could see what it all does.
 
Upvote 0
@Joe4 will post my entire code in this comment. I tried to follow all the guidelines for good programming in VBA. But this is my first ever macro, and I know there are things that should be done differently here, so don't be too mad :D But other than that, thank you for your help!

VBA Code:
Sub ImportIOs()

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False

'If no basis are selected for import throw error
If Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets("Basis").Range("B15:Z15"), "Y") = 0 Then
    MsgBox ("No basis were selected for Individual Output import. Please check row 15 of sheet 'Basis' and try again."), , "Error"
    Exit Sub
End If

'Variable declaration
Dim MyObject As Object, File As Object, Folder As Object, SubFolders As Object
Dim Path As String, RRPath As String, BaselinePath As String, LiabPath As String, ValDate As String, ValYear As String, StudioNode As String, DiscountMethod As String, Import As String
Dim RowBasis As Range, RowIO As Range, HideColumns As Range, ToFormat As Range

'Get folder name of the client (added to "Client Specific" tab on CP)
ValDate = Worksheets("Client specific").Cells(6, "B").Value
DiscountMethod = Worksheets("Client specific").Cells(13, "B").Value
Set RowBasis = ThisWorkbook.Worksheets("Basis").Range("B17:Z17")
Set RowIO = ThisWorkbook.Worksheets("Ind Output").Range("A1:KU1")
Set HideColumns = ThisWorkbook.Worksheets("Ind Output").Range("A1:KU3")

'Use ValDate to derive Valuation Year
If Month(ValDate) = 1 Then
    ValYear = Year(ValDate) - 1
Else
    ValYear = Year(ValDate)
End If

'Create object to be able to access file directories and create path to network folder of NL Valuations
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set Folder = MyObject.GetFolder("\\abc.com\xxxxxxxxxx\" + Worksheets("Client specific").Cells(5, "B").Value + "\")
Set SubFolders = Folder.SubFolders

'Iterate through the folders within the folder of the client. If any of those folders contains our Valuation Year, take that path and append it some other paths,
'and assign those values to some variables
For Each SubFolders In SubFolders
    If InStr(SubFolders.Name, ValYear) Then
        RRPath = SubFolders.Path + "\03-Liabilities\01-ReplicationRun\"
        BaselinePath = SubFolders.Path + "\03-Liabilities\02-Baseline\"
        LiabPath = SubFolders.Path + "\03-Liabilities\04-OngoingBasis\"
    Exit For
    End If
Next

'Iterate through Basis row in Sheet "Basis" and check if Studio Valuation Node is filled. If so store that in a variable used to retrieve the name of the IO file.
'Otherwise hide the column
For Each Cell In RowBasis.Cells
    If Cell.Offset(2, 0).Value = "" Then
        StudioNode = ""
    Else
        StudioNode = Cell.Offset(2, 0).Value & ".xlsx"
    End If

    Import = Cell.Offset(-2, 0).Value

 'Iterate through basis row in Sheet "Ind Output" and try to find a match with the basis looped above. If match found take the name of the node and use it to open the respective IO and copy  the data to the "Ind Output" sheet
   
    For Each CellIO In RowIO.Cells
        If (Cell = CellIO) And (Not StudioNode = "") And UCase(Import) = "Y" Then
            If InStr(StudioNode, "Replication") Or InStr(StudioNode, "RR") Then
                Set File = MyObject.GetFolder(RRPath)
            ElseIf InStr(StudioNode, "Baseline") Then
                Set File = MyObject.GetFolder(BaselinePath)
            Else
                Set File = MyObject.GetFolder(LiabPath)
            End If

            For Each File In File.Files
                Workbooks.Open File
                Set ToFormat = Workbooks(StudioNode).Worksheets("Sheet1").Columns("A")

                With ToFormat
                    .NumberFormat = "General": .Value = .Value
                End With

                Workbooks(StudioNode).Worksheets("Sheet1").Range("A7", Range("I7").End(xlDown)).Copy
                ThisWorkbook.Worksheets("Ind Output").Range(CellIO.Offset(2, -1).Address(0, 0)).PasteSpecial Paste:=xlPasteValues

                Application.CutCopyMode = False
                Workbooks(StudioNode).Close (False)
            Next File
        ElseIf (Cell = CellIO) And (StudioNode = "") Then
            If (CellIO.Interior.Color = RGB(255, 255, 153) Or CellIO.Interior.Color = RGB(250, 191, 143)) And CellIO.HasFormula = True Then
                If (CellIO = "Last Time Basis" Or CellIO = "PBO") Then
                    ThisWorkbook.Worksheets("Ind Output").Range(CellIO.Offset(2, -1).Address(0, 0) & ":" & CellIO.Offset(2, 14).Address(0, 0)).EntireColumn.Hidden = True
                Else
                    ThisWorkbook.Worksheets("Ind Output").Range(CellIO.Offset(2, -1).Address(0, 0) & ":" & CellIO.Offset(2, 12).Address(0, 0)).EntireColumn.Hidden = True
                End If
            End If
            ThisWorkbook.Worksheets("Basis").Range(Cell.Address(0, 0)).EntireColumn.Hidden = True
        End If
    Next CellIO
Next Cell

'Iterate through a range in Sheet "Ind Output" and hide grey columns
For Each Cell In HideColumns.Cells
    If Cell.DisplayFormat.Interior.ColorIndex = 16 Then
        Range(Cell.Address(0, 0)).EntireColumn.Hidden = True
    End If
Next Cell

ThisWorkbook.Worksheets("Basis").Range("AA:AC").EntireColumn.Hidden = True

On Error GoTo ErrMsg
    Set ToFormat = ThisWorkbook.Worksheets("Ind Output").Range("A15", Range("KU15").End(xlDown)).SpecialCells(xlCellTypeConstants)
  
    'Apply formatting to rows that fall out of the formatted range in Sheet "Ind Output"
    With ToFormat
        .Cells.Interior.Color = RGB(255, 255, 153)
        .Cells.Borders(xlEdgeBottom).Color = RGB(0, 0, 0)
        .Cells.Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
        .Cells.Borders(xlEdgeRight).Color = RGB(0, 0, 0)
        .Cells.Borders(xlEdgeTop).Color = RGB(0, 0, 0)
        .Cells.Borders(xlInsideVertical).Color = RGB(0, 0, 0)
        .Cells.Borders(xlInsideHorizontal).Color = RGB(0, 0, 0)
    End With

    Cells(1, 1).Select
Exit Sub

'Show error when basis is selected for import but no Studio Node is provided
ErrMsg:
    MsgBox ("No data to display. Please try again."), , "Error"

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayStatusBar = True

End Sub
 
Last edited by a moderator:
Upvote 0
OK, I don't see anything that stands out, but since there are other applications involved, I don't know if there is a good way to tell if the delay may be there.
Turning off screen updating while the code is running typically makes your code faster or have no impact on it.
But if you are experiencing that it runs faster without it, then I would say go ahead and run it without it.
 
Upvote 0
Yeah, you are right. VBA goes into network folders so the delay could be somewhere in there.
I will do as you advised.

While you are at it, did you see anything glaringly wrong with my code that I should rectify (in terms of best practices I mean)?

Again, thank you so much for your help!
 
Upvote 0
One thing I would strongly advise is to turn on Option Explicit, which will force you to declare all your variables (you have some undeclared ones).
This is a great tool to help prevent against typos, or the wrong data type being entered into a variable.
See: Option Explicit in Excel VBA
 
Upvote 0
You are welcome.

You can do it manually to existing VBA code by adding the phrase "Option Explicit" at the top of any VBA module.
Then, if you try compiling the code (Debug -> Compile VBA Project), it will alert you of those instances and force you to declare the variable (or fix any typos) before you are able to run the code.
 
Upvote 0
Solution
Yeah, I followed your recommendation and found out I had a few undeclared variables. Really handy!

Thank you!
 
Upvote 0
I can see one thing in your code :)

You are not turning back ScreenUpdating, Events and AutoCalc on if you exit sub with the first if check. This may cause issues in other places if not here in case you have more macros's calling each other or rely on events etc.

VBA Code:
'If no basis are selected for import throw error
If Application.WorksheetFunction.CountIf(ThisWorkbook.Worksheets("Basis").Range("B15:Z15"), "Y") = 0 Then
    MsgBox ("No basis were selected for Individual Output import. Please check row 15 of sheet 'Basis' and try again."), , "Error"
    Exit Sub
End If
 
Upvote 0

Forum statistics

Threads
1,214,584
Messages
6,120,387
Members
448,956
Latest member
JPav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top