Results 1 to 6 of 6

Thread: [RESOLVED] How to speed up a Change Event Loop (Excel 2016)

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Jan 2008
    Posts
    167

    Resolved [RESOLVED] How to speed up a Change Event Loop (Excel 2016)

    Hi Guys,

    I have written the below code, the purpose of which is to loop through areas of a worksheet looking for changes and once the change has been found to peform an action or to run another Sub Routine.

    The code loops 400 times looking for what has changed, it takes between 1 and 2 seconds to run which includes running the Sub Routine, is there a way that I can make this faster?

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    
    
     Dim KeyCells As Range
     Dim Rw As Long, Col As Long, Rng As Range
     Dim shtlf As Worksheet, rngCal As Range, rngVal As Range
     Dim pdat As Date, shtDates As Worksheet
     Dim rngDate As Range, strDT As String, a As Long
    
    pdat = VBA.Format(Now(), "dd/mm/yyyy")
    
    Set shtlf = ActiveWorkbook.Sheets("Line Flow")
    Set shtDates = ActiveWorkbook.Sheets("Dates")
    With shtDates
    Set rngDate = .Range("A:A")
    End With
    With rngDate
    shtDT = .Find(pdat, , xlValues, xlWhole).Offset(, 2).Value
    End With
    With shtlf.Rows(6)
    Col = .Find(shtDT, , xlValues, xlWhole).Column
    End With
    
    
    ' Updating OTB Row
    
        ' The variable KeyCells contains the cells that will
        ' cause an alert when they are changed.
        
     ' **************************
     ' Add Loop for how ever many MSKU are being planned
     ' **************************
       
     Rw = 9 ' First MSKU, for subsequent MSKU add 48
     
    For a = 1 To 400 ' Loops through all sections
        Set KeyCells = Sheets("Line Flow").Range(Cells(Rw, Col), Cells(Rw, Col + 52))
       Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    Set rngOTBTarget = Target
    
    
    ' sets worksheet object variables
    Set shtlf = ActiveWorkbook.Sheets("Line Flow")
    Application.EnableEvents = False
    
    'Debug.Print (WorksheetFunction.Sum(KeyCells) & " " & WorksheetFunction.Sum(Target))
    'Debug.Print (KeyCells.Address & " " & Target.Address)
    If WorksheetFunction.Sum(KeyCells) = 0 And WorksheetFunction.Sum(Target) = 0 Then
    
    shtlf.Range(Cells(Rw + 40, Target.Column).Address, Cells(Rw + 43, Target.Column).End(xlToRight).Address).Value = 0 ' resets the macro destinations to 0
    End If
    
    'Application.EnableEvents = True ' testing only
    
    Call New_OTB_Routine
    Application.Calculation = xlCalculationManual
    
    End If
    
    ' Allocation Row
     Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 6, Col), Cells(Rw + 6, Col + 52))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    ' Override Sales Row
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 10, Col), Cells(Rw + 10, Col + 52))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    ' Override Sales Row
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 10, Col), Cells(Rw + 10, Col + 52))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    ' Reschedule Rows
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 17, Col), Cells(Rw + 17, Col + 52))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 18, Col), Cells(Rw + 18, Col + 52))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 21, Col), Cells(Rw + 21, Col + 52))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 22, Col), Cells(Rw + 22, Col + 52))
      ' Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 25, Col), Cells(Rw + 25, Col + 52))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 26, Col), Cells(Rw + 26, Col + 52))
      ' Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 29, Col), Cells(Rw + 29, Col + 52))
      ' Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 30, Col), Cells(Rw + 30, Col + 52))
      ' Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    ' WH Cover Target
    
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 6, 4), Cells(Rw + 6, 4))
      ' Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    ' Profiler
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 8, 3), Cells(Rw + 8, 4))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    
    
    ' WH Overrides
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 16, 4), Cells(Rw + 19, 4))
       'Debug.Print (KeyCells.Address)
    
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    shtlf.Calculate
    End If
    Rw = Rw + 48
     Next a
     
    Application.EnableEvents = True
    
    End Sub

  2. #2
    Super Moderator si_the_geek's Avatar
    Join Date
    Jul 2002
    Location
    Bristol, UK
    Posts
    41,929

    Re: How to speed up a Change Event Loop (Excel 2016)

    Your code is very hard to read due to poor indenting, and in some cases short variable names (especially a , which can't sensibly be searched for). As such there may be things we miss, or get wrong.

    First of all, the lines like this aren't reliable:
    Code:
        Set KeyCells = Sheets("Line Flow").Range(Cells(Rw, Col), Cells(Rw, Col + 52))
    The Cells references don't specify a sheet, so Excel has to 'guess'. It might get the one you intended, but it might not.

    The proper way to write that line is:
    Code:
        Set KeyCells = Sheets("Line Flow").Range(Sheets("Line Flow").Cells(Rw, Col), Sheets("Line Flow").Cells(Rw, Col + 52))
    ...or, because you have a variable for the sheet, this shorter version will be a bit faster:
    Code:
        Set KeyCells = shtlf.Range(shtlf.Cells(Rw, Col), shtlf.Cells(Rw, Col + 52))
    ...and the ones with just one cell, eg:
    Code:
    Set KeyCells = Sheets("Line Flow").Range(Cells(Rw + 6, 4), Cells(Rw + 6, 4))
    can be reduced to just the cell reference:
    Code:
    Set KeyCells = shtlf.Cells(Rw + 6, 4)

    Next, there is no need to use Range(Target.Address) , because Target is already a range, so you can just use that. The way you have it adds two extra steps that slow it down unnecessarily.


    There are some things inside the loop that don't seem like they need to be in there (such as Set shtlf = ActiveWorkbook.Sheets("Line Flow") ). Having them inside the loop means they run hundreds of times, whereas moving them before the loop means they only run once.


    Finally, in several places you call shtlf.Calculate , which presumably takes a big chunk of time. Think about whether you really need to run that inside the loop at all: if it doesn't affect the behaviour of other code before the 'next' then you shouldn't allow it to run it multiple times before you get there; if it also doesn't affect later iterations of the loop, it shouldn't be inside the loop at all.
    Last edited by si_the_geek; Jan 28th, 2019 at 11:17 AM.

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Jan 2008
    Posts
    167

    Re: How to speed up a Change Event Loop (Excel 2016)

    Thank you for your advice, and apologies for the sloppy code.

  4. #4
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    4,418

    Re: How to speed up a Change Event Loop (Excel 2016)

    If that code is supposed to run only in the workbook it's contained in: Get rid of this "ActiveWorkbook"-Crap.
    On general: I try to avoid all that Active-Something-Crap like the plague.

    You let the code run, and while it's running you start another workbook, which becomes active...... KABOOM
    Last edited by Zvoni; Tomorrow at 31:69 PM.
    ----------------------------------------------------------------------------------------

    One System to rule them all, One Code to find them,
    One IDE to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    Code is like a joke: If you have to explain it, it's bad

  5. #5
    Fanatic Member
    Join Date
    Feb 2013
    Posts
    985

    Re: How to speed up a Change Event Loop (Excel 2016)

    I would also make use of the target more effectively, the very first thing right of the bat you should be checking if target is one of the cells or ranges you need to check, for example a very fast way of doing this is your checking a column for a date....

    Code:
    'lets assume date column is 6
    IF NOT target.Column = 6 then exit sub
    
    ......rest of the code down here.....
    so immediately this prevents the loops and all the finds running every time u press something which is ALOT when your using excel. this will not speed up when you actually change a key cell but it will make all other changes faster.

    Also just to expand on Si's statement regarding calculations, you can specify which cells to calculate by using a range i believe.

    This would just just calculate on a specific column for example.

    Code:
    Range.Columns(2).Calculate
    My biggest advice which would ultimately mean reworking your entire code would be to replace all of your excel functions with VBA, this has certain benefits the main one being you can control exactly what is being changed faster than you can using calculate, second is you can set up the loop using an array and use that instead of calling on all of these objects which you are currently doing, the array method for finding and manipulating data is almost ALWAYS 10 to 100 times faster that relying of excel ranges and other objects.

    but as i said that last peace of advice should have been setup from the start, changing you workbook now would ultimately mean restarting all your work.
    Yes!!!
    Working from home is so much better than working in an office...
    Nothing can beat the combined stress of getting your work done on time whilst
    1. one toddler keeps pressing your AVR's power button
    2. one baby keeps crying for milk
    3. one child keeps running in and out of the house screaming and shouting
    4. one wife keeps nagging you to stop playing on the pc and do some real work.. house chores
    5. working at 1 O'clock in the morning because nobody is awake at that time
    6. being grossly underpaid for all your hard work


  6. #6

    Thread Starter
    Addicted Member
    Join Date
    Jan 2008
    Posts
    167

    Re: [RESOLVED] How to speed up a Change Event Loop (Excel 2016)

    Thanks for all your help guys on this..

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width