Macro takes long when run first time

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,034
Office Version
  1. 2016
Platform
  1. Windows
Hello Friends,

I am using the below code which is working perfect apart from the problem that it takes almost 25 seconds when running for first time after I open the workbook. After that when run for the second or third time > it takes only 6 to 7 seconds.

Do you guys have any idea why this is happening.

VBA Code:
Private Sub update_database()
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Run "calculation_off"
  
    Dim ws As Worksheet
                     
Set WSArray = Workbooks("REPORTS.xlsm").Worksheets(Array("INDEX", "DATABASE", "R VALIDATION", "R DAILY PRODUCTION", "R FRI DPI LABTEST", "R PO DESIGN COLOUR"))

For Each ws In WSArray
ws.Unprotect Password:="merchant"
If ws.AutoFilterMode Then ws.AutoFilterMode = False
Next
   
    Workbooks.Open Filename:="C:/OneDrive/Documents/DATA ENTRY.xlsm"
           
    '''''''''''''''''''''''''''''''''''''''''''
    
    Workbooks("REPORTS.xlsm").Worksheets("R VALIDATION").Cells.ClearContents
    Workbooks("DATA ENTRY.xlsm").Worksheets("VALIDATION").Cells.Copy
    Workbooks("REPORTS.xlsm").Worksheets("R VALIDATION").Range("A1").PasteSpecial Paste:=xlPasteValues
    
    '''''''''''''''''''''''''''''''''''''''''''
    Workbooks("REPORTS.xlsm").Worksheets("DATABASE").Range("A2:AO2").ClearContents
    Workbooks("REPORTS.xlsm").Worksheets("DATABASE").Range("orders").ClearContents
    Workbooks("DATA ENTRY.XLSM").Worksheets("ORDERS").Range("A2:AO10000").Copy
    Workbooks("REPORTS.xlsm").Worksheets("DATABASE").Range("A4").PasteSpecial Paste:=xlPasteValues
    
    '''''''''''''''''''''''''''''''''''''''''''
    
    Workbooks("REPORTS.xlsm").Worksheets("R DAILY PRODUCTION").Cells.ClearContents
    Workbooks("DATA ENTRY.xlsm").Worksheets("DAILY PRODUCTION").Cells.Copy
    Workbooks("REPORTS.xlsm").Worksheets("R DAILY PRODUCTION").Range("A1").PasteSpecial Paste:=xlPasteValues
    
    '''''''''''''''''''''''''''''''''''''''''''
    
    Workbooks("REPORTS.xlsm").Worksheets("R FRI DPI LABTEST").Cells.ClearContents
    Workbooks("DATA ENTRY.xlsm").Worksheets("FRI DPI LABTEST").Cells.Copy
    Workbooks("REPORTS.xlsm").Worksheets("R FRI DPI LABTEST").Range("A1").PasteSpecial Paste:=xlPasteValues
    
    '''''''''''''''''''''''''''''''''''''''''''
    
    Workbooks("REPORTS.xlsm").Worksheets("R PO DESIGN COLOUR").Cells.ClearContents
    Workbooks("DATA ENTRY.xlsm").Worksheets("PO DESIGN COLOUR").Cells.Copy
    Workbooks("REPORTS.xlsm").Worksheets("R PO DESIGN COLOUR").Range("A1").PasteSpecial Paste:=xlPasteValues
    
    '''''''''''''''''''''''''''''''''''''''''''
    
Workbooks("DATA ENTRY.xlsm").Close savechanges:=False
   
 Sheets("INDEX").Range("J16").Value = Now
        
   For Each ws In WSArray
   ws.Protect Password:="merchant", DrawingObjects:=True, Contents:=True, Scenarios:=True _
       , AllowFormattingColumns:=True, AllowFormattingRows:=True
      
Next

Application.Run "update_quality_article_unit"

End Sub

Any help would be appreciated

Regards,

Humayun
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
L

Legacy 456155

Guest
Sort of shot in the dark, but what is your "Files On-Demand" setting in OneDrive? If it is checked and that is what you want for most files, you can go to the file in question in windows explorer, right click on it, and select "Always keep on this device." My first suspicion is that you are having to download the file upon first use because, perhaps, it was changed from some other source.
 

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,034
Office Version
  1. 2016
Platform
  1. Windows
Hi dataluver,

Thanks for the reply but that is not the case I reckon. See here is another code which does not have to donwload anything. Its just doing some copy paste stuff within the workbook. It takes over 10 seconds for the first time. After that it takes 3 seconds.

Here is the code - having same problem :(

VBA Code:
Private Sub update_quality_article_unit()
 
  Dim ws As Worksheet
 
  Set WSArray = Workbooks("REPORTS.xlsm").Worksheets(Array("DATABASE", "Supplier Wise", "Year Wise"))
   
  For Each ws In WSArray
  ws.Visible = xlSheetVisible
  ws.Unprotect Password:="merchant"
  If ws.AutoFilterMode Then ws.AutoFilterMode = False
  Next

   Worksheets("Supplier Wise").Range("B11:D123,B129:D161").ClearContents
   Worksheets("Year Wise").Range("B11:D123,B129:D161").ClearContents
     
    ' Below line is commented out coz already run in updating databse
    'Worksheets("DATABASE").Range("A2:AO2").ClearContents
   
    Sheets("DATABASE").Select
    Range("F4", Range("F4").End(xlDown)).Copy Range("BA4")
    Range("G4", Range("G4").End(xlDown)).Copy Range("BB4")
    Range("M4", Range("M4").End(xlDown)).Copy Range("BC4")

    'Remove Duplicate Start
     Worksheets("DATABASE").Range("BA4:BC4", Range("BA4:BC4").End(xlDown)).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
    'Remove Duplicate End
   
   'Sorting Start
    Range("BA4:BC4", Range("BA4:BC4").End(xlDown)).Select
    Worksheets("DATABASE").Sort.SortFields.Clear
    Worksheets("DATABASE").Sort.SortFields.Add Key:=Range("BB4:BB4", Range("BB4:BB4").End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Worksheets("DATABASE").Sort.SortFields.Add Key:=Range("BA4:BA4", Range("BA4:BA4").End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Worksheets("DATABASE").Sort.SortFields.Add Key:=Range("BC4:BC4", Range("BC4:BC4").End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Set(s),Pc(s),Pair(s),Dozen(s)", DataOption:=xlSortNormal
    With Worksheets("DATABASE").Sort
        .SetRange Range("BA4:BC4", Range("BA4:BC4").End(xlDown))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   'Sorting End
   
    Range("BA4:BC4", Range("BA4:BC4").End(xlDown)).Copy
   
    Sheets("Supplier Wise").Range("B11").PasteSpecial Paste:=xlPasteValues
    Sheets("Year Wise").Range("B11").PasteSpecial Paste:=xlPasteValues
   
    Sheets("DATABASE").Range("BB4", Range("BB4").End(xlDown)).ClearContents
   
    Range("BC4", Range("BC4").End(xlDown)).Cut Range("BB4")
       
    'Sorintg Start
    Range("BA4:BB4", Range("BA4:BB4").End(xlDown)).Select
    Worksheets("DATABASE").Sort.SortFields.Clear
    Worksheets("DATABASE").Sort.SortFields.Add Key:=Range("BA4:BA4", Range("BA4:BA4").End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Worksheets("DATABASE").Sort.SortFields.Add Key:=Range("BB4:BB4", Range("BB4:BB4").End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Set(s),Pc(s),Pair(s),Dozen(s)", DataOption:=xlSortNormal
    With Worksheets("DATABASE").Sort
        .SetRange Range("BA4:BB4", Range("BA4:BB4").End(xlDown))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'Sorting End
   
    'Remove Duplicate Start
     Range("BA4:BB4", Range("BA4:BB4").End(xlDown)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    'Remove Duplicate End
   
   Range("BA4", Range("BA4").End(xlDown)).Copy
   Sheets("Supplier Wise").Range("B129").PasteSpecial Paste:=xlPasteValues
   Sheets("Year Wise").Range("B129").PasteSpecial Paste:=xlPasteValues
   
   Sheets("DATABASE").Range("BB4", Range("BB4").End(xlDown)).Copy
  
   Sheets("Supplier Wise").Range("D129").PasteSpecial Paste:=xlPasteValues
   Range("C1").Select
   
   Sheets("Year Wise").Range("D129").PasteSpecial Paste:=xlPasteValues
   Range("C1").Select
   
   Sheets("DATABASE").Range("BA4:BB4", Range("BA4:BB4").End(xlDown)).ClearContents
   Range("A3").Select
   
   
    For Each ws In WSArray
   ws.Protect Password:="merchant", DrawingObjects:=True, Contents:=True, Scenarios:=True _
       , AllowFormattingColumns:=True, AllowFormattingRows:=True
    
   ws.Visible = xlSheetVeryHidden
  
   Next
   
    End Sub
 
L

Legacy 456155

Guest
I don't have a clue. I have no idea what links, code, formulas, etc are running/refreshing in those other workbooks. How long does it take to open your workbook while holding the shift key when opening? Holding the shift key will keep code from running. If there's no slow down without code, we can at least begin to narrow it down.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,107
Messages
5,622,782
Members
415,927
Latest member
vedasinternational

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