Macro Speed Optimization

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
121
Office Version
  1. 2016
Platform
  1. Windows
Hi Members,

I have the below macro which I am using for my Timer/values copy purpose and has served my purpose well until now. Off late I am seeing some speed Issues and excel goes to "Not responding" several times. In combination, I am using the "Timer5" macro - Application. Ontine method (used in below macro) to loop below macro every second.

Looking for suggestions as to if I can optimize the macro for speed or if I am doing something wrong fundamentally.

Please note that:-

1. the conditions in the said macro used Range("B2:B173") are met for most of the cells per second and macro is doing some busy work.
2. Some other Copy. Paste Data macros are also used to copy some data per second from one sheet to another (1 second Loop) and these macros have synced well historically.

VBA Code:
Sub Timer()
If Time >= ThisWorkbook.Sheets("Control").Range("E17").Value2 Then Exit Sub

Dim Cell As Range
Application.ScreenUpdating = False
    

For Each Cell In Workbooks("Dater").Sheets("Timer").Range("B2:B173")
If Cell.Value <> Cell.Offset(0, 9).Value Then
        Cell.Offset(0, 7).Value = Now
        Cell.Offset(0, 9).Value = Cell.Value
        Cell.Offset(0, 8).Value = Cell.Offset(0, 4).Value
        Cell.Offset(0, 10).Value = Cell.Offset(0, 10).Value + 1
        Cell.Offset(0, 24).Value = 1
        Cell.Offset(0, 27).Value = 0
        Cell.Offset(0, 28).Value = 0
    ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "LR" Then
        Cell.Offset(0, 11).Value = Cell.Offset(0, 11).Value + 1
    ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "NR" Then
        Cell.Offset(0, 12).Value = Cell.Offset(0, 12).Value + 1
    ElseIf Cell.Offset(0, 10).Value <> Cell.Offset(0, 14).Value And Cell.Value = "HR" Then
        Cell.Offset(0, 13).Value = Cell.Offset(0, 13).Value + 1
    ElseIf Cell.Offset(0, 25).Value <> Cell.Offset(0, 26).Value Then
        Cell.Offset(0, 23).Value = Cell.Offset(0, 2).Value
        Cell.Offset(0, 24).Value = Cell.Offset(0, 24).Value + 1
        Cell.Offset(0, 29).Value = Now
    ElseIf Cell.Offset(0, 2).Value < Cell.Offset(0, 27).Value Then
        Cell.Offset(0, 27).Value = Cell.Offset(0, 2).Value
    ElseIf Cell.Offset(0, 2).Value > Cell.Offset(0, 28).Value Then
        Cell.Offset(0, 28).Value = Cell.Offset(0, 2).Value
        
    End If
Next
Columns("I:I").EntireColumn.AutoFit
Call Timer5

Application.ScreenUpdating = True
End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,976
Office Version
  1. 2010
Platform
  1. Windows
One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.

So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 172 rows it is much quicker to load the 172 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),

I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.
Practically every line of your code accesses the worksheet. There is so much of it i haven't got the time to rewrite it. However the good news your code is about as slow as you possible make it so you shoud be able to rewrite using array and it will 100 times faster ( I mean about 100)
A loop of 172 is trivial when done entirely in vba
Just as an example of the difference in speed try running these two macros in a blank workbook one uses array the other access the cells in a loop they both do the same calculation and display the same results:
VBA Code:
Sub slow()
Dim myrange As Range
Dim cell As Range
Dim elasped As Double

starttim = Timer()
i = 1
Set myrange = Range("A1:D100")
For Each cell In myrange
 cell = i + 1
 i = i + 1
Next cell
elaspsed = 1000 * (Timer() - starttim)
MsgBox elaspsed & " millisec"


End Sub

Sub fast()
Dim myrange As Variant
Dim cell As Range
Dim elasped As Double

starttim = Timer()
i = 1
 myrange = Range("A1:D100")
For k = 1 To UBound(myrange, 1)
   For j = 1 To UBound(myrange, 2)
     myrange(k, j) = i + 1
      i = i + 1
   Next j
Next k
Range("A1:D100") = myrange

elaspsed = 1000 * (Timer() - starttim)
MsgBox elaspsed & " millisec"
The slow routine takes 156 millisecs on my machine, the fast routine is so fast it comes back with 0 millisecs most of the time
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
121
Office Version
  1. 2016
Platform
  1. Windows
Thanks for the insight..quite interesting to know., but I am not sure if I will be able to re-adapt my macro as per above with self-help. I Will give it a try and will share my revived code in case I am able to do so.
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,976
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

I have now found the time to rewrite your code using variant arrays:
VBA Code:
Sub test()
If Time >= ThisWorkbook.Sheets("Control").Range("E17").Value2 Then Exit Sub

Application.ScreenUpdating = False
    
inarr = Workbooks("Dater").Sheets("Timer").Range("B2:AD173")
For i = 1 To 172
'For Each Cell In Workbooks("Dater").Sheets("Timer").Range("B2:B173")
If (inarr(i, 1) <> inarr(i, 9)) Then
'If Cell.Value <> Cell.Offset(0, 9).Value Then
        
        inarr(i, 7) = Now()
        inarr(i, 9) = inarr(i, 1)
        inarr(i, 8) = inarr(i, 4)
        inarr(i, 10) = inarr(i, 10) + 1
        inarr(i, 24) = 1
        inarr(i, 27) = 0
        inarr(i, 28) = 0
    ElseIf inarr(i, 10) <> inarr(i, 14) And inarr(i, 1) = "LR" Then
        inarr(i, 11) = inarr(i, 11) + 1
    ElseIf inarr(i, 10) <> inarr(i, 14) And inarr(i, 1) = "NR" Then
        inarr(i, 12) = inarr(i, 12) + 1
    ElseIf inarr(i, 10) <> inarr(i, 14) And inarr(i, 1) = "HR" Then
        inarr(i, 13) = inarr(i, 13) + 1
    ElseIf inarr(i, 25) <> inarr(i, 26) Then
        inarr(i, 23) = inarr(i, 2)
        inarr(i, 24) = inarr(i, 24) + 1
        inarr(i, 29) = Now()
    ElseIf inarr(i, 2) < inarr(i, 27) Then
        inarr(i, 27) = inarr(i, 2)
    ElseIf inarr(i, 2) > inarr(i, 28) Then
        inarr(i, 28) = inarr(i, 2)
        
    End If
Next i
Workbooks("Dater").Sheets("Timer").Range("B2:AD173") = inarr
Columns("I:I").EntireColumn.AutoFit  ' for real speed I recommend setting the width once outside the macro
Call Timer5

Application.ScreenUpdating = True
End Sub
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
121
Office Version
  1. 2016
Platform
  1. Windows
I have now found the time to rewrite your code using variant arrays:
VBA Code:
Sub test()
If Time >= ThisWorkbook.Sheets("Control").Range("E17").Value2 Then Exit Sub

Application.ScreenUpdating = False
   
inarr = Workbooks("Dater").Sheets("Timer").Range("B2:AD173")
For i = 1 To 172
'For Each Cell In Workbooks("Dater").Sheets("Timer").Range("B2:B173")
If (inarr(i, 1) <> inarr(i, 9)) Then
'If Cell.Value <> Cell.Offset(0, 9).Value Then
       
        inarr(i, 7) = Now()
        inarr(i, 9) = inarr(i, 1)
        inarr(i, 8) = inarr(i, 4)
        inarr(i, 10) = inarr(i, 10) + 1
        inarr(i, 24) = 1
        inarr(i, 27) = 0
        inarr(i, 28) = 0
    ElseIf inarr(i, 10) <> inarr(i, 14) And inarr(i, 1) = "LR" Then
        inarr(i, 11) = inarr(i, 11) + 1
    ElseIf inarr(i, 10) <> inarr(i, 14) And inarr(i, 1) = "NR" Then
        inarr(i, 12) = inarr(i, 12) + 1
    ElseIf inarr(i, 10) <> inarr(i, 14) And inarr(i, 1) = "HR" Then
        inarr(i, 13) = inarr(i, 13) + 1
    ElseIf inarr(i, 25) <> inarr(i, 26) Then
        inarr(i, 23) = inarr(i, 2)
        inarr(i, 24) = inarr(i, 24) + 1
        inarr(i, 29) = Now()
    ElseIf inarr(i, 2) < inarr(i, 27) Then
        inarr(i, 27) = inarr(i, 2)
    ElseIf inarr(i, 2) > inarr(i, 28) Then
        inarr(i, 28) = inarr(i, 2)
       
    End If
Next i
Workbooks("Dater").Sheets("Timer").Range("B2:AD173") = inarr
Columns("I:I").EntireColumn.AutoFit  ' for real speed I recommend setting the width once outside the macro
Call Timer5

Application.ScreenUpdating = True
End Sub


Thanks for being so kind to write it up for me. It would have taken me ages to write a macro in this manner.

I tested the code and I think it is ultra-fast.... the only issue is it is turning formulas(conditions) in the sheet to values. Many conditions which macro is checking is via formulas to other sheets.

Regards,

Vablearner
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
121
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

@Vbalearner85 do you have a link to a workbook that we can test

I am delighted that for your revert.... @ offthelip has advised the above code and seems to be working well except for some minor teething issues. I would like to hold spending your valuable time for now and will reach out as needed
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,976
Office Version
  1. 2010
Platform
  1. Windows
Which columns have got formula in them? because there are two choices: either we need to avoid overwriting the formulae, or we save the formulea and rewrite after. This depends on where the formulae are
 

Vbalearner85

Board Regular
Joined
Jun 9, 2019
Messages
121
Office Version
  1. 2016
Platform
  1. Windows
There are 5-6 columns having formulas..starting column B Range("B2:B173"), columns C-D, Columns Z-AB .This macro is required to keep track of changes every second and act accordingly with its steps and keeping formulas intact is one of key requirement

Else I have to copy data another sheet for those columns every sec..
Regards
 
Last edited:

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,339
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Column Z has formulas? what part?
 

Forum statistics

Threads
1,141,583
Messages
5,707,207
Members
421,498
Latest member
matinebi

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
Top