Code runs instantly when launched from VBA editor, but when called in the spreadsheet takes a while.

vbaNumpty

Board Regular
Joined
Apr 20, 2021
Messages
160
Office Version
  1. 365
Platform
  1. Windows
I have code that when I click Run in the VBA window executes instantly, however when it is called in the spreadsheet either with change event code or the assigned shortcut the mouse icon shows a loading circle icon as the macro does it's thing and takes upwards of a minute when the volume of data is higher.

How can I get the macro to perform similarly in speed to the VBA run function?
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

igold

Well-known Member
Joined
Jul 8, 2014
Messages
2,695
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
It would be nice to see the code...
 

vbaNumpty

Board Regular
Joined
Apr 20, 2021
Messages
160
Office Version
  1. 365
Platform
  1. Windows
It would be nice to see the code...
the code is the following:

VBA Code:
Sub filterDay()
    'macro to change shipping sheet
    Dim i As Integer
    Dim j As Integer
    Dim x As Integer
    Dim y As Integer
    Dim n As Integer
    Dim ordrList As Range
    Dim findValue As Range
    Dim addMe As Range
    Dim brdRange As Range
    Dim ordSht As Worksheet
    Dim dshBoard As Worksheet
    Dim myarray As Variant
    Dim tday As Date
    
    On Error GoTo errHandler:
    
    Application.ScreenUpdating = False
    
    Set ordSht = Sheet3
    Set dshBoard = Sheet1
    
    ordSht.Range("S1").value = "Ship Date"
    ordSht.Range("S2").value = Sheet1.Range("V1")
    
    ordSht.Range("A2:L1048576").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    ordSht.Range("$S$1:$S$2"), CopyToRange:=ordSht.Range("$U$1:$AF$1"), Unique:=False
    
    ordSht.Select
    With ordSht
        .Range("U2:AF1048576").Sort Key1:=Range("AB2"), Order1:=xlAscending, Header:=xlGuess
    End With
    
    Set ordrList = Sheet3.Range("outdata")
    
    myarray = ordrList
    i = Sheet3.Range("T1").value
        
    For j = 1 To i
    
        Set addMe = dshBoard.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    
        Set findValue = ordSht.Range("A:A").Find(What:=myarray(j, 1), _
            LookIn:=xlValues, lookat:=xlWhole)
            
        x = findValue.Offset(0, 12).value
        n = 0
    
        addMe.value = myarray(j, 3) 'customer
        addMe.Offset(0, 15).value = Evaluate("=INDEX(CustomerTable[Salesperson],MATCH(""" & addMe.value & """,CustomerTable[Customer],0))") 'salesperson
        addMe.Offset(0, 16).value = myarray(j, 9) ' delivery method
        addMe.Offset(0, 17).value = myarray(j, 8) ' ship time
        addMe.Offset(0, 17).NumberFormat = "h:mm AM/PM"
            
            For y = 2 To x
            
                addMe.Offset(n, 1).value = findValue.Offset(y, 0).value 'product
                addMe.Offset(n, 2).value = findValue.Offset(y, 2).value 'cases
                addMe.Offset(n, 3).value = findValue.Offset(y, 3).value 'pack size
                addMe.Offset(n, 4).value = findValue.Offset(y, 4).value 'Staging
                addMe.Offset(n, 5).value = findValue.Offset(y, 5).value 'assortment
                addMe.Offset(n, 6).value = findValue.Offset(y, 6).value 'colour
                addMe.Offset(n, 7).value = findValue.Offset(y, 7).value 'cover
                addMe.Offset(n, 8).value = findValue.Offset(y, 8).value 'ornament
                addMe.Offset(n, 9).value = findValue.Offset(y, 9).value 'upc
                addMe.Offset(n, 10).value = findValue.Offset(y, 10).value 'caretag
                addMe.Offset(n, 11).value = findValue.Offset(y, 11).value 'insulation
                addMe.Offset(n, 12).value = findValue.Offset(y, 12).value 'sleeve
                addMe.Offset(n, 13).value = findValue.Offset(y, 13).value 'notes
                addMe.Offset(n, 14).value = findValue.Offset(y, 14).value 'box label
                
                'formatting
                addMe.Offset(n, 1).VerticalAlignment = xlCenter
                
                With addMe.Offset(0, 2).Resize(x - 1, 14)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                
                addMe.Offset(n, 6).WrapText = True
                
                addMe.Offset(n, 13).WrapText = True

                n = n + 1
                
            Next y
        
        addMe.Offset(x - 1, 0).value = "no one can see this :)"
        
        With addMe.Offset(x - 1, 0).EntireRow.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight1
        End With
       
        addMe.Resize(x - 1).Merge
        With addMe
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .WrapText = True
        End With
        
        With addMe.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 65535
        End With
        
        addMe.Offset(0, 15).Resize(x - 1).Merge
        With addMe.Offset(0, 15)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .WrapText = True
        End With
        
        addMe.Offset(0, 16).Resize(x - 1).Merge
        With addMe.Offset(0, 16)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .WrapText = True
        End With
        
        addMe.Offset(0, 17).Resize(x - 1).Merge
        With addMe.Offset(0, 17)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .WrapText = True
        End With
        
        With addMe.Resize(x - 1, 18).Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        
    Next j
    
    
    Sheet1.Select
    
    Exit Sub
    
errHandler:

    Sheet1.Select

    MsgBox "No orders are in the system for the selected date.", vbOKOnly + vbInformation, "No Orders Found"
    
End Sub

Trying to understand why the code runs fast when run from the editor but not in the following change event:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$V$1" Then
        Call filterDay
    End If

End Sub

Even If I remove the change event the code still runs slow
 

Forum statistics

Threads
1,143,909
Messages
5,721,450
Members
422,363
Latest member
Bogus_Potatoes

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