VBA copy pastespecial has become slow

[pwylie007]

Hi All,

I've been using the following code for around 18 months and have had no problems, but suddenly it is taking longer than acceptable to run.

Sub Expenses_AddItem()
With Expenses
If .Range("E5").Value = Empty Then
MsgBox "Please enter a correct date"
Exit Sub
End If
If .Range("E7").Value = Empty Then
MsgBox "Please enter a Vendor"
Exit Sub
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ProdName = .Range("B6").Value 'Product Name
ProdDBRow = .Range("B7").Value 'Product DB Row
LastItemRow = .Range("E99999").End(xlUp).Row
.Range("E" & LastItemRow + 1).Value = ProdName
.Range("F" & LastItemRow + 1) = 1 'Quantity
.Range("I9").Copy
.Range("I" & LastItemRow + 1).PasteSpecial xlPasteFormulas
.Range("K9").Copy
.Range("K" & LastItemRow + 1).PasteSpecial xlPasteFormulas
.Range("L9").Copy
.Range("L" & LastItemRow + 1).PasteSpecial xlPasteFormulas
.Range("M9").Copy
.Range("M" & LastItemRow + 1).PasteSpecial xlPasteFormulas
.Range("N9").Copy
.Range("N" & LastItemRow + 1).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
Expense_SetFooter
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
.Range("F" & LastItemRow + 1).Select
End With

End Sub

Note that it appears to be the copy command that is causing the issue.

The computer that I am having the issues on is running Windows 11 Home build 22621, and Office 365 2309 build 16827.20130. I've tried a roll back to the version noted below and tried reinstalliing Office 365 but to no avail.

I've tested the model on another computer and works as per normal. This computer is running Windows 11 Pro build 22621, and Office 365 2308 build 16731.20234.

Any thoughts would be appreciated.

Thanks,

 

[BigBeachBananas]

I optimized your code a bit by eliminating some of the redundancy.

WARNING: UNTESTED CODE- Try this on a copy of your workbook.

Sub Expenses_AddItem()
   Dim Expenses As Worksheet
   Set Expenses = ThisWorkbook.Sheets("Expenses") ' <~~Replace with the actual sheet name
 
   If IsEmpty(Expenses.Range("E5").Value) Then
       MsgBox "Please enter a correct date"
       Exit Sub
   End If

   If IsEmpty(Expenses.Range("E7").Value) Then
       MsgBox "Please enter a Vendor"
       Exit Sub
   End If

   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual

   Dim ProdName As String
   Dim ProdDBRow As Variant
   ProdName = Expenses.Range("B6").Value ' Product Name
   ProdDBRow = Expenses.Range("B7").Value ' Product DB Row

   Dim LastItemRow As Long
   LastItemRow = Expenses.Cells(Expenses.Rows.Count, "E").End(xlUp).Row + 1
 
   Expenses.Range("E" & LastItemRow).Value = ProdName
   Expenses.Range("F" & LastItemRow).Value = 1 ' Quantity

   Expenses.Range("I9,K9,L9,M9,N9").Copy
   Expenses.Range("I" & LastItemRow & ":N" & LastItemRow).PasteSpecial xlPasteFormulas
   Application.CutCopyMode = False

   Expense_SetFooter
 
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic

   Expenses.Range("F" & LastItemRow).Select
End Sub

 

[pwylie007]

Thanks, there seems to be a slight improvement.

What I'm at a loss to understand is why two weeks prior the macro worked at a more acceptable rate and has done so for 18 months.

 

[BigBeachBananas]

Try stepping through the code line by line and see which is taking a long time. It might be the UDF Expense_SetFooter.

 

[pwylie007]

Thanks, I have done that and it is definitely the copy command.

I tested this by commenting out the copy commands. This filled out the product item as quickly as expected. I left in the call to Expense_SetFooter, the code for which is below.

Sub Expense_SetFooter()
With Expenses.Shapes("FooterGrp")
.Left = Expenses.Range("I11").Left
.Top = Expenses.Range("E" & Expenses.Range("I99999").End(xlUp).Row + 2).Top - 3
.Width = Expenses.Range("I:K").Width
End With
End Sub

I then reinstated one of the copy commands and it took several seconds for the macro to run.

 

[BigBeachBananas]

Try this on a COPY of your workbook see if it's any better.

Sub Expenses_AddItem()
    Dim Expenses As Worksheet
    Set Expenses = ThisWorkbook.Sheets("Expenses") ' Replace with the actual sheet name

    If IsEmpty(Expenses.Range("E5").Value) Then
        MsgBox "Please enter a correct date"
        Exit Sub
    End If

    If IsEmpty(Expenses.Range("E7").Value) Then
        MsgBox "Please enter a Vendor"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim ProdName As String
    Dim ProdDBRow As Variant
    ProdName = Expenses.Range("B6").Value ' Product Name
    ProdDBRow = Expenses.Range("B7").Value ' Product DB Row

    Dim LastItemRow As Long
    LastItemRow = Expenses.Cells(Expenses.Rows.Count, "E").End(xlUp).Row + 1

    Expenses.Range("E" & LastItemRow).Value = ProdName
    Expenses.Range("F" & LastItemRow).Value = 1 ' Quantity

    Dim FormulaRange As Range
    Set FormulaRange = Expenses.Range("I9,N9") ' Adjust the range as needed
    FormulaRange.AutoFill Destination:=Expenses.Range("I" & LastItemRow & ":N" & LastItemRow), Type:=xlFillDefault

    Expense_SetFooter

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Expenses.Range("F" & LastItemRow).Select
End Sub

 

[pwylie007]

Hi,

Thanks again for helping.

Unfortunately I get a run-time error - Autofill method of Range class failed

Cheers,

 

[BigBeachBananas]

It's hard for me to visualize what's on the sheet. If you can share a sample without any sensitive information.

 

[pwylie007]

Hi,

I've tried using XL2BB but the area I'm trying to capture is too large, so have attached a screen grab.

For context, the model is an accounting and reporting tool for a restaurant and this specific tab is to capture supplier invoices using a point and click methodology to select the products being acquired.

The macro I am having issues with is called when I select the product item - e.g. Bread Crumbs.

The macro populates the product name and quantity and then copies the formulae in I9 to N9 against the product name, the first of which is row 11. Once the whole invoice has been entered the user clicks on the Next button to copy the expense into a table and clears the "form". As indicated, it is the copying of the formulae in I9 to N9 that has suddenly increased the amount of time taken to select a product, from almost immediately to several seconds.

Many thanks again,