Slow code

M

MichaelRSnow

Active Member
Joined
Aug 3, 2010
Messages
409
Hi, I'm filtering a spreadsheet using VBA inside a module (spreadsheet holds 50k+ rows of data) and these steps below take 7 minutes to execute?

Any advice on how this could be done differently to drastically speed up run time?

VBA Code: 
'Get all products
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=Range("P:P").Column
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=Range("Q:Q").Column
ThisWorkbook.Sheets("Prod_Data").Range("W1:W150000").SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Sheets("Prod_Data_Rsts").Range("M1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Application.CutCopyMode = False
    
ThisWorkbook.Sheets("Prod_Data").Range("P1:P150000").SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Sheets("Prod_Data_Rsts").Range("N1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Application.CutCopyMode = False

ThisWorkbook.Sheets("Prod_Data").Range("D1:D150000").SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Sheets("Prod_Data_Rsts").Range("O1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Application.CutCopyMode = False

With ActiveWorkbook.Worksheets("Prod_Data_Rsts").ListObjects("Table1").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("Table1[Product Start Date]"), SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
End With
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
Hi @MichaelRSnow .

To make the macro more efficient, you have to put all the data in memory using arrays.
Then read the data from the arrays and copy the data you need to the Prod_Data_Rsts sheet.
That is conceptually what should be done.

To do this I'm trying to understand your macro.

1. You have these 2 lines that remove the autofilter from the P and Q columns. Is that correct?
VBA Code: 
  ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=Range("P:P").Column
  ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=Range("Q:Q").Column

2. You have this other line that copies only the visible rows, it means that the data is filtered by another column. Is that correct?
VBA Code: 
ThisWorkbook.Sheets("Prod_Data").Range("W1:W150000").SpecialCells(xlCellTypeVisible).Copy
We can know what those criteria are to filter the data.
You can put all the criteria you use to filter and in which columns each criteria applies.
In this way, the filter would be carried out in memory and the result would be copied to the "Prod_Data_Rsts" sheet.

3. Do you have formulas on sheet "Prod_Data"?
Do you have formulas on sheet "Prod_Data_Rsts"?

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------​
 
Upvote 0
Hi, thanks for your help

Point1 and 2, you're are correct

Point 3,
I have 1 formula in Prod_Data sheet
Excel Formula: 
=SUBTOTAL(3,A2:A100000)& " Product(s) Found"
I have many formulas in Prod_Data_Rsts, all similar to the examples below
Excel Formula: 
=IFERROR(INDIRECT("Prod_Data!F"&MIN(IF(SUBTOTAL(3,OFFSET(Prod_Data!A2,ROW(Prod_Data!B2:F100000)-ROW(Prod_Data!A2),,1)),ROW(Prod_Data!B2:F100000)))),"")
=IFERROR(VLOOKUP($C$2,Prod_Data!$A$1:$BB$100000,4,FALSE),"")

I have applied c.30 other filters to Prod_Data sheet prior to the previous code, are you asking to see all that code? there is 56 columns of data and 50k+ rows

To explain what its trying to do,
You answer a bunch of variable and hit 'locate' button, the code stores these variable answers as string, long, or double and then later filters the columns by these stored variables
The variables should always return 1 visible row, errors if not, and the formula above displays the key data from that top row or lookups up other data if required

The copy and paste code is used to un-filter two columns and pull a list of information, this is done to grab similar results that are not an a exact match, its this part of the code that is very slow
 
Last edited:
Upvote 0
MichaelRSnow said:
Hi, I'm filtering a spreadsheet using VBA inside a module (spreadsheet holds 50k+ rows of data) and these steps below take 7 minutes to execute?

Any advice on how this could be done differently to drastically speed up run time?
Click to expand...
Just a note that when you have a lot of inter-related data (i.e. lots of data, lookup functions, and filters), what you are probably describing is actually a Relational Database.
While you can "brute force" Excel to act like one, this is NOT what is was designed for, and hence tends to get slow and clunky, especially as your data grows.
It would be far more efficient in Relational Database program, like Microsoft Access or SQL, as this is precisely what these programs were designed for.

Something to think about, long-term.
If you are stuck using Excel, you may want to look into using Power Query in Excel, which allows you to do database-type operations from within Excel.
We have a forum for all the Power products here, named Power Tools.
 
Upvote 0
Joe4 said:
Just a note that when you have a lot of inter-related data (i.e. lots of data, lookup functions, and filters), what you are probably describing is actually a Relational Database.
While you can "brute force" Excel to act like one, this is NOT what is was designed for, and hence tends to get slow and clunky, especially as your data grows.
It would be far more efficient in Relational Database program, like Microsoft Access or SQL, as this is precisely what these programs were designed for.

Something to think about, long-term.
If you are stuck using Excel, you may want to look into using Power Query in Excel, which allows you to do database-type operations from within Excel.
We have a forum for all the Power products here, named Power Tools.
Click to expand...
Problem is i'm trying to provide a look up tool and the end users wont have access to Access or SQL db, they do all have excel so I need to find the most efficient way of filter a large amount data in excel and return results if possible, I appreciate its not perfect and ideally they would be running the SQL query I ran to get the data in the first place but that isn't possible
 
Upvote 0
MichaelRSnow said:
I have many formulas in Prod_Data_Rsts, all similar to the examples below
Click to expand...
It's very likely that the volatile OFFSET() and INDIRECT() functions are the main factors of the bogging down and in some circumstances it is possible to avoid those functions altogether or at least mitigate their deficiencies - but, assuming that the VBA is the main problem and that is doesn't rely on any recalculations part way though you could try adding:

This line at the very start of your code Application.Calculation = xlCalculationManual
And this at the very end Application.Calculation = xlCalculationAutomatic
 
Upvote 0
FormR said:
It's very likely that the volatile OFFSET() and INDIRECT() functions are the main factors of the bogging down and in some circumstances it is possible to avoid those functions altogether or at least mitigate their deficiencies - but, assuming that the VBA is the main problem and that is doesn't rely on any recalculations part way though you could try adding:

This line at the very start of your code Application.Calculation = xlCalculationManual
And this at the very end Application.Calculation = xlCalculationAutomatic
Click to expand...
I'll give it a try in the morning and see if that helps
 
Upvote 0
MichaelRSnow said:
I have applied c.30 other filters to Prod_Data sheet prior to the previous code, are you asking to see all that code? there is 56 columns of data and 50k+ rows
Click to expand...
Do you have a macro that applies all the filters?
Put that macro here.

--------
If you have formulas in sheet and apply filters that will make the sheet very slow.
That's why the macro in post #1 is very slow, it removes filters and copies filtered data.
Comments: If you step through your macro with F8, which line of the macro is the slowest?
-------

If the lines of code suggested by "FormR" don't reduce the execution time, then...

MichaelRSnow said:
To explain what its trying to do,
You answer a bunch of variable and hit 'locate' button, the code stores these variable answers as string, long, or double and then later filters the columns by these stored variables
The variables should always return 1 visible row, errors if not, and the formula above displays the key data from that top row or lookups up other data if required
Click to expand...

To make everything faster, I will apply the filters to all the columns (the 56) with a macro.
That is, your data on sheet "Prod_Data" should remain unfiltered, then the new macro will do the in-memory filter and put the data on sheet "Prod_Data_Rsts".

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------​
 
Upvote 0
DanteAmor said:
Do you have a macro that applies all the filters?
Put that macro here.

--------
If you have formulas in sheet and apply filters that will make the sheet very slow.
That's why the macro in post #1 is very slow, it removes filters and copies filtered data.
Comments: If you step through your macro with F8, which line of the macro is the slowest?
-------

If the lines of code suggested by "FormR" don't reduce the execution time, then...



To make everything faster, I will apply the filters to all the columns (the 56) with a macro.
That is, your data on sheet "Prod_Data" should remain unfiltered, then the new macro will do the in-memory filter and put the data on sheet "Prod_Data_Rsts".

--------------
I hope to hear from you soon.
Respectfully
Dante Amor
--------------​
Click to expand...
This is the code that applies the filters originally


VBA Code: 
'Apply Filters
'BORROWER TYPE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=26, Criteria1:=Existing_Borrower
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=27, Criteria1:=First_Time_Buyer
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=28, Criteria1:=New_Borrower
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=29, Criteria1:=Remortgage
If Further_Advance = "Y" Then
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=30, Criteria1:=Further_Advance
If Internal_Remortgage = "Y" Then
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=31, Criteria1:=Internal_Remortgage
End If
End If

ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=32, Criteria1:=Rate_Switch
'OWNERSHIP TYPE
    If OWNERSHIP_TYPE = "" Then
    ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=37, Criteria1:="N" 'Equity Share Only hidden as others share ranges
    Else
        If OWNERSHIP_TYPE = "Standard" Then
        ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=37, Criteria1:="N"
        Else
            If OWNERSHIP_TYPE = "Equity Share" Then
            ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=37, Criteria1:=Equity_Share
            Else
                If OWNERSHIP_TYPE = "Shared Ownership" Then
                ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=38, Criteria1:=Shared_Ownership
                Else
                    If OWNERSHIP_TYPE = "Right to Buy" Then
                    ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=39, Criteria1:=Right_to_Buy
                    Else
                        If OWNERSHIP_TYPE = "Genuine Bargain Price" Then
                        ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=41, Criteria1:=Genuine_Bargain_Price
                        Else
                            If OWNERSHIP_TYPE = "Restricted Resale Price" Then
                            ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=42, Criteria1:=Restricted_Resale_Price
                            Else
                                If OWNERSHIP_TYPE = "Negative Equity" Then
                                ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=40, Criteria1:=Negative_Equity
                                Else
                                    If OWNERSHIP_TYPE = "New Build" Then
                                    ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=25, Criteria1:=New_Build
                                    Else
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
'LTV
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=6, Criteria1:="<=" & LOAN_TO_VALUE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=7, Criteria1:=">=" & LOAN_TO_VALUE

ActiveWorkbook.Worksheets("Prod_Data_Rsts").Range("H2").Value = 8
ActiveWorkbook.Worksheets("Prod_Data_Rsts").Range("I9").Value = Now()
Call ColourChange

'PRODUCT TYPE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=5, Criteria1:="=*" & PRODUCT_TYPE & "*", Operator:=xlAnd
'DATE AVAILABLE

ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=17, Criteria1:=">=" & DATE_AVAILABLE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=16, Criteria1:="<=" & DATE_AVAILABLE
'FEE
If FEE = "YES" Then
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=10, Criteria1:="<>"
Else
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=10, Criteria1:=""
End If
'FREE LEGAL
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=11, Criteria1:=FREE_LEGALS
'CASHBACK
If CASHBACK = 1 Then
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=13, Criteria1:=">0"
Else
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=13, Criteria1:=""
End If

ActiveWorkbook.Worksheets("Prod_Data_Rsts").Range("H2").Value = 9
ActiveWorkbook.Worksheets("Prod_Data_Rsts").Range("I10").Value = Now()
Call ColourChange

'INTEREST ONLY
    If INTEREST_ONLY = "Y" Then
    ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=14, Criteria1:=INTEREST_ONLY
    Else
        If INTEREST_ONLY = "N" Then
        ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=14, Criteria1:="<>"
        Else
        End If
    End If
'ERC
If EARLY_REPAYMENT_CHARGE = 0 Then
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=15, Criteria1:=""
Else
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=15, Criteria1:="<>"
End If
'FIXED OR TRACKER
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=36, Criteria1:=FIXED_OR_TRACKER
'HIGH FEE
If HIGH_PRODUCT_FEE = 1499 Then
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=10, Criteria1:=HIGH_PRODUCT_FEE
Else
End If

'PROPOISTION TYPES
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=45, Criteria1:=HELPING_HAND
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=44, Criteria1:=DEPOSIT_UNLOCK
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=46, Criteria1:=SWITCH_ADDITIONAL_BORROWING
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=48, Criteria1:=REPAY_HELP_TO_BUY
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=49, Criteria1:=GREEN
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=47, Criteria1:=FAMILY_DEPOSIT_MORTGAGE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=50, Criteria1:=OVER_55s_MORTGAGES
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=33, Criteria1:=INDEAL_SWITCH_RANGE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=34, Criteria1:=SWITCH_FIX_RANGE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=43, Criteria1:=SAVE_TO_BUY
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=51, Criteria1:=FLEXCLUSIVE
ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=52, Criteria1:=BORROWING_INTO_RETIREMENT

But i'll try the suggested tomorrow and see how it goes
 
Upvote 0
1. You didn't put the full macro. 🫤

2. If copying information from sheet "Prod_Data" to sheet "Prod_Data_Rsts" and then you have formulas that use data from sheet "Prod_Data_Rsts" to bring other data from sheet "Prod_Data", the ideal is for the macro to collect the data from sheet 1 and put them together with the copied data. That is, the formulas would not be necessary.
MichaelRSnow said:
I have many formulas in Prod_Data_Rsts, all similar to the examples below
Excel Formula: 
=IFERROR(INDIRECT("Prod_Data!F"&MIN(IF(SUBTOTAL(3,OFFSET(Prod_Data!A2,ROW(Prod_Data!B2:F100000)-ROW(Prod_Data!A2),,1)),ROW(Prod_Data!B2:F100000)))),"")
=IFERROR(VLOOKUP($C$2,Prod_Data!$A$1:$BB$100000,4,FALSE),"")
Click to expand...

3. And speaking of formulas, I suppose that in sheet "Prod_Data_Rsts" you have 50 thousand rows with formulas waiting for the information from sheet "Prod_Data". And probably only 1000 rows are used and you'll have 49 thousand rows with unused formulas.
That doesn't help the blade's performance. Plus you have the formulas in a table. I also recommend that you put the data in cells. And remove the rows with formulas you don't use.

4. In addition to the "FormR" lines, I recommend the following.
Rich (BB code): 
Sub test()

  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
  End With

  'Get all products
  ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=Range("P:P").Column
  ThisWorkbook.Sheets("Prod_Data").Range("A1:BE1").AutoFilter Field:=Range("Q:Q").Column
  ThisWorkbook.Sheets("Prod_Data").Range("W1:W150000").SpecialCells(xlCellTypeVisible).Copy
  ThisWorkbook.Sheets("Prod_Data_Rsts").Range("M1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
  Application.CutCopyMode = False
    
  ThisWorkbook.Sheets("Prod_Data").Range("P1:P150000").SpecialCells(xlCellTypeVisible).Copy
  ThisWorkbook.Sheets("Prod_Data_Rsts").Range("N1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
  Application.CutCopyMode = False
 
  ThisWorkbook.Sheets("Prod_Data").Range("D1:D150000").SpecialCells(xlCellTypeVisible).Copy
  ThisWorkbook.Sheets("Prod_Data_Rsts").Range("O1").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
  Application.CutCopyMode = False
 
  With ActiveWorkbook.Worksheets("Prod_Data_Rsts").ListObjects("Table1").Sort
  .SortFields.Clear
  .SortFields.Add Key:=Range("Table1[Product Start Date]"), SortOn:=xlSortOnValues, Order:=xlAscending
         .Header = xlYes
         .Apply
  End With
 
 
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
  End With
 
End Sub

5. And last, if you opt for a new macro, put here a sample of your data from the 2 sheets, change the sensitive information for generic data.
Or share a file.
You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

;)
 
Upvote 1
Solution
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
185
willow1985
willow1985
C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
139
myall_blues
myall_blues
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
157
CapRavOr
C
H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
466
skillilea
S
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
347
Azamamir
A

Forum statistics

Threads
1,216,515
Messages
6,131,111
Members
449,621
Latest member
feaugcruz

Share this page

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