My VBA macro slows down dramatically with each use

0 votes

My VBA macro creates a data table on a named range, copies the data table as values, then exports the data table to a text file. The issue I have is that the macro takes a lot longer to run than it did the last time I ran it. However, if I restart Excel, the run time "resets" and drops once more. I've even occasionally seen an error message saying that Excel has run out of resources.

Here is the macro:

Sub PR_Calculate()
'
' Total Macro
'
    Application.ScreenUpdating = False
    
    Range("Output").Clear
    
    Range("CurrentOutput").Table ColumnInput:=Range("CurrentOutput").Cells(1, 1) 'apply data table to required range
      
    Range("Output").Font.Size = 8
    Range("Output").Font.Name = "Segoe UI"
    
    Application.Calculation = xlCalculationAutomatic
    Application.Calculation = xlCalculationSemiautomatic
    
    Range("Output").Copy
    Range("Output").PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False

    Dim outputPath1 As String
    Dim outputPath2 As String
    
    outputPath1 = ActiveWorkbook.Worksheets("Run Setup").Range("OutputPath") & Range("CurrentRunParameters").Cells(2, 1).Value & "." & Range("CurrentRunParameters").Cells(2, 2).Value & ".txt"
    outputPath2 = ActiveWorkbook.Worksheets("Run Setup").Range("OutputPath") & Range("CurrentRunParameters").Cells(2, 1).Value & "." & Range("CurrentRunParameters").Cells(2, 2).Value & ".Headings.txt"

    Call ExportRange(ActiveWorkbook.Worksheets("Policy Results").Range("FileSaveRange"), outputPath1, ",") 'call function to export results to .txt file
    Call ExportRange(ActiveWorkbook.Worksheets("Policy Results").Range("HeadingSaveRange"), outputPath2, ",") 'call function to export results to .txt file
    
End Sub

Function ExportRange(WhatRange As Range, _
         Where As String, Delimiter As String) As String

  Dim HoldRow As Long    'test for new row variable
  HoldRow = WhatRange.Row
    
  Dim c As Range

  'loop through range variable
  For Each c In WhatRange
    If HoldRow <> c.Row Then
      'add linebreak and remove extra delimeter
      ExportRange = Left(ExportRange, Len(ExportRange) - 1) _
                          & vbCrLf & c.Text & Delimiter
        HoldRow = c.Row
    Else
        ExportRange = ExportRange & c.Text & Delimiter
    End If
Next c

'Trim extra delimiter
ExportRange = Left(ExportRange, Len(ExportRange) - 1)

'Kill the file if it already exists
If Len(Dir(Where)) > 0 Then
    Kill Where
End If

Open Where For Append As #1    'write the new file
Print #1, ExportRange
Close #1
End Function

I've tried removing sections of the code piece by piece but it always seems to slow down after consecutive runs.

Jan 21, 2023 in Others by Kithuzzz
• 38,020 points
657 views

1 answer to this question.

0 votes

You have a function called ExportRange that is implemented as a string, but you call it from a subroutine while using the function ExportRange variable, whose value appears to/could increase over time. I would experiment with using a Dim String in place of the function as a local variable for itself. Declare the global variable outside the function if you need one. Possibly like this:

Dim MyExportRange As String

Sub ExportRange(WhatRange As Range, _
         Where As String, Delimiter As String)

  Dim HoldRow As Long    'test for new row variable
  HoldRow = WhatRange.Row
    
  Dim c As Range

  MyExportRange = ""

  'loop through range variable
  For Each c In WhatRange
    If HoldRow <> c.Row Then
      'add linebreak and remove extra delimeter
      MyExportRange = Left(MyExportRange, Len(MyExportRange) - 1) _
                          & vbCrLf & c.Text & Delimiter
        HoldRow = c.Row
    Else
        MyExportRange = MyExportRange & c.Text & Delimiter
    End If
Next c

'Trim extra delimiter
MyExportRange = Left(MyExportRange, Len(MyExportRange) - 1)

'Kill the file if it already exists
If Len(Dir(Where)) > 0 Then
    Kill Where
End If

Open Where For Append As #1    'write the new file
Print #1, MyExportRange
Close #1
End Sub
answered Jan 21, 2023 by narikkadan
• 63,720 points

Related Questions In Others

0 votes
1 answer

VBA code help - Add a line for each missing date with the start and end date defined in a cell

Try this: Sub FillDates() Dim ...READ MORE

answered Jan 24, 2023 in Others by narikkadan
• 63,720 points
904 views
0 votes
1 answer

What VBA code would I use to concatenate cell A2 & B2 in cell C2 and then have it Autofill down the column?

Solution Find the last row. Write a formula to ...READ MORE

answered Feb 14, 2023 in Others by Kithuzzz
• 38,020 points
877 views
0 votes
1 answer

VBA: My Email .body doesn't concatenate with itself: application-defined or object-defined error

Try this: 'Somewehere declare this string variable Dim incomingHTMLBody ...READ MORE

answered Feb 16, 2023 in Others by narikkadan
• 63,720 points
770 views
0 votes
1 answer

Autofill Copy down up until next empty row- Excel VBA Macro

Row 1048576 will be returned by end(xldown) ...READ MORE

answered Feb 18, 2023 in Others by narikkadan
• 63,720 points
1,459 views
0 votes
1 answer

How can increase the speed of if statement in VBA Code?

Use a Dictionary Object. Option Explicit Sub PreencherO() ...READ MORE

answered Feb 7, 2023 in Others by narikkadan
• 63,720 points
489 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
1,079 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
3,495 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
803 views
0 votes
1 answer

How To Use VBA To Share Excel File With Fellow Office User?

PowerApps were referenced; if you have a ...READ MORE

answered Oct 28, 2022 in Others by narikkadan
• 63,720 points
1,217 views
0 votes
1 answer

How do I use the Indirect Function in Excel VBA to incorporate the equations in a VBA Macro Function

Try this: Sub Test() Dim str As String: str ...READ MORE

answered Jan 19, 2023 in Others by narikkadan
• 63,720 points
928 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP