-
Jan 28th, 2019, 09:27 AM
#1
Thread Starter
Addicted Member
[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
-
Jan 28th, 2019, 11:13 AM
#2
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.
-
Jan 28th, 2019, 11:43 AM
#3
Thread Starter
Addicted Member
Re: How to speed up a Change Event Loop (Excel 2016)
Thank you for your advice, and apologies for the sloppy code.
-
Jan 29th, 2019, 01:47 AM
#4
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
-
Jan 30th, 2019, 07:56 AM
#5
Fanatic Member
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
-
Jan 30th, 2019, 08:10 AM
#6
Thread Starter
Addicted Member
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|