Macro slowing down after each use?

[kingofaces]

So yeah, this is going to be kind of vague, especially since I don't have a simple code I can post since it's a pretty big project. The bulk of the macro is a section of code that gets looped through a couple thousand times. That section mainly deals with multiple variables that are either determining the location of a specific cell value to use, calculate sums, put final calculated values into an array, etc. Now each time it goes through this loop, is there something that could be slowing it down that is being stored from from the previous loop, even after the procedure is entirely finished?

Instead of looping the macro for a couple thousand rows, I only have it looping for 7 right now. Generally it takes 15 seconds to to run through that entire set at first. However, if I run the macro multiple times, the calculation time starts to creep up to the point where it's taking 25 seconds for this same amount of data when the only thing I'm doing is just selecting to run the macro again. I would expect that calculation time would be the same for the 1st run as it would be for the 100th time running it. Closing out of Excel and opening up the file again does bring the calculation time back down to 15 seconds though. This adds up after a couple thousand rows of data, and it's not exactly feasible to exit out of Excel when it seems like it's slowed to a crawl. Any thoughts on what could be causing this or general things I should double-check? It seems like something accumulating in the background is going on, but I'm not exactly sure on where to start looking. The code used for each loop shouldn't be storing data each time, just calculating and putting it into an array.

 

[hiker95]

kingofaces,

Please post your macro code.


At the beginning of your posted code, enter the following without the * character:
[*code]


'Your code goes here.


At the end of your posted code, enter the following without the * character:
[*/code]

 

[kingofaces]

I figured it would be quicker and easier if there were some common mistakes people make that I could keep an eye out for rather than trying to explain what I'm doing with the macro so that someone could check it over. That's why I mentioned that didn't intend to post it, but if you can pick something out of there have at it:

Sub calcDD()

Dim Benchmark As Double
Dim endtime As Double
Dim Temprangename As String
Dim Row2 As Long
Dim Row4 As Long
Dim Row5 As Long
Dim Ddrow As Long
Dim Method As String
Dim Fillrange As String
Dim Fillstart As String
Dim Column1 As String
Dim Column2 As String
Dim Column3 As String
Dim Accform As String
Dim Startform As String
Dim Myrow As Long
Dim Myrow2 As Long
Dim Location As String
Dim Year As Integer
Dim Startcol As Integer
Dim Midcol As Integer
Dim Endcol As Integer
Dim Rowob As Long
Dim Analysisrow As Long
Dim Clearrange As String
Dim Analysisendrow As Long
Dim Observedendrow As Long
Dim Avg25 As Double
Dim Avg50 As Double
Dim Avg75 As Double
Dim undercatch As Double
Dim blank As Long
Dim tot25 As Double
Dim tot50 As Double
Dim tot75 As Double
Dim Endrow As Long
Dim Flight As String
Dim GDD25 As Double
Dim GDD50 As Double
Dim GDD75 As Double
Dim jday As Double
Dim StartDate As String
Dim LT As Double
Dim UT As Double
Dim Endrow2 As Double
Dim Analysisrow1 As Double
Dim Analysisrow2 As Double
Dim Arrayrowend As Double
Dim Errorcount As Double
Dim GDDcorrect As Long
Dim jTemprangename As String
Dim jColumn1 As String
Dim jColumn2 As String
Dim jColumn3 As String
Dim jStartform As String
Dim jMyrow As Long
Dim jLocation As String
Dim jYear As Integer
Dim jStartcol As Integer
Dim jMidcol As Integer
Dim jEndcol As Integer
Dim jRowob As Long
Dim jObservedendrow As Long
Dim Julianstart As Long
Dim Datecorrect As Long
Dim Mydate As Date
Dim Mymonth As Integer
Dim Myday As Integer
Dim Arraycolumn As Long
Dim Matchstart As Long
Dim Matchend As Long
Dim PrevMethod As String
Dim PrevLT As Long
Dim PrevUT As Long
Dim ReCalcDD As Boolean
Dim Percentdone As String

Application.ScreenUpdating = False
Application.Calculation = xlAutomatic
Benchmark = Timer

Analysisendrow = Worksheets("Analysis").Range("A1:F1").End(xlDown).Row
Endrow2 = Analysisendrow + 3
Observedendrow = Sheets("Observed Flight").Range("A2:C2").End(xlDown).Row
undercatch = WorksheetFunction.CountIf(Worksheets("Observed Flight").Range("C3:C" & Observedendrow), "<50")
blank = WorksheetFunction.CountBlank(Worksheets("Observed Flight").Range("C3:C" & Observedendrow))
Arrayrowend = Observedendrow - blank - undercatch
    
    
ReDim Predict25Array(1 To Arrayrowend, 1 To Endrow2)
ReDim Predict50Array(1 To Arrayrowend, 1 To Endrow2)
ReDim Predict75Array(1 To Arrayrowend, 1 To Endrow2)


Predict25Array(1, 1) = "Location"
Predict25Array(1, 2) = "Year"
Predict25Array(1, 4) = "Observed"
Predict50Array(1, 1) = "Location"
Predict50Array(1, 2) = "Year"
Predict50Array(1, 4) = "Observed"
Predict75Array(1, 1) = "Location"
Predict75Array(1, 2) = "Year"
Predict75Array(1, 4) = "Observed"
Predict25Array(1, 3) = "Rep"
Predict50Array(1, 3) = "Rep"
Predict75Array(1, 3) = "Rep"
        Errorcount = 0
        
        For Myrow = 3 To Observedendrow
       
       
Catchpoint1:
        Location = Sheets("Observed Flight").Cells(Myrow, 1)
        Year = Sheets("Observed Flight").Cells(Myrow, 2)
        Temprangename = Location & "_" & Year
        
        
         If Worksheets("Daily Temps").Range(Temprangename)(1, 3) = "Catch" Then
         Myrow = Myrow + 1
         Errorcount = Errorcount + 1
         GoTo Catchpoint1
    
         End If
         
        Myrow2 = Myrow - 1
        
           'rep designation, change later
       Select Case Location
       Case Is = "Aurora"
    Predict25Array(Myrow2 - Errorcount, 3) = 1
    Predict50Array(Myrow2 - Errorcount, 3) = 1
    Predict75Array(Myrow2 - Errorcount, 3) = 1
    Case Is = "Clay_Center"
    Predict25Array(Myrow2 - Errorcount, 3) = 2
    Predict50Array(Myrow2 - Errorcount, 3) = 2
    Predict75Array(Myrow2 - Errorcount, 3) = 2
    Case Is = "Concord"
    Predict25Array(Myrow2 - Errorcount, 3) = 3
    Predict50Array(Myrow2 - Errorcount, 3) = 3
    Predict75Array(Myrow2 - Errorcount, 3) = 3
    Case Is = "North_Platte"
    Predict25Array(Myrow2 - Errorcount, 3) = 4
    Predict50Array(Myrow2 - Errorcount, 3) = 4
    Predict75Array(Myrow2 - Errorcount, 3) = 4
    End Select
    
            
    Predict25Array(Myrow2 - Errorcount, 4) = Worksheets("Observed Flight").Range("G" & Myrow).Value
    Predict50Array(Myrow2 - Errorcount, 4) = Worksheets("Observed Flight").Range("H" & Myrow).Value
    Predict75Array(Myrow2 - Errorcount, 4) = Worksheets("Observed Flight").Range("I" & Myrow).Value
    

    Next Myrow
    
    
For Analysisrow = 2 To Analysisendrow

 
    PrevMethod = Method
    PrevLT = LT
    PrevUT = UT

    Julianstart = Sheets("Analysis").Range("D" & Analysisrow)
    Analysisrow2 = Analysisrow + 3
    
    Method = Worksheets("Analysis").Range("A1")(Analysisrow, 1)
        Mydate = Worksheets("Analysis").Range("C" & Analysisrow)
            Mymonth = DatePart("m", Mydate)
            Myday = DatePart("d", Mydate)
    StartDate = Mymonth & "_" & Myday
    LT = Worksheets("Analysis").Range("A1")(Analysisrow, 5)
    UT = Worksheets("Analysis").Range("A1")(Analysisrow, 6)
    
    'Checks if StartDate is only difference in method
    If PrevMethod = Method And PrevLT = LT And PrevUT = UT Then
    ReCalcDD = True
    Else: ReCalcDD = False
    End If
    
    Predict25Array(1, Analysisrow2) = Method & "_" & StartDate & "_" & LT & "_" & UT
    Predict50Array(1, Analysisrow2) = Method & "_" & StartDate & "_" & LT & "_" & UT
    Predict75Array(1, Analysisrow2) = Method & "_" & StartDate & "_" & LT & "_" & UT
    
    
    
     Errorcount = 0
    
        For Myrow = 3 To Observedendrow
       
       
Catchpoint2:
        Rowob = Myrow - 1
        Location = Sheets("Observed Flight").Cells(Myrow, 1)
        Year = Sheets("Observed Flight").Cells(Myrow, 2)
        Flight = Worksheets("Analysis").Range("B" & Analysisrow).Value
        Temprangename = Location & "_" & Year
        
        
         If Worksheets("Daily Temps").Range(Temprangename)(1, 3) = "Catch" Then
         Myrow = Myrow + 1
         Errorcount = Errorcount + 1
         GoTo Catchpoint2
    
         End If
         
        Year = Worksheets("Observed Flight").Range("A1")(Myrow, 2)
        Predict25Array(Rowob - Errorcount, 1) = Location
        Predict25Array(Rowob - Errorcount, 2) = Year
        Predict50Array(Rowob - Errorcount, 1) = Location
        Predict50Array(Rowob - Errorcount, 2) = Year
        Predict75Array(Rowob - Errorcount, 1) = Location
        Predict75Array(Rowob - Errorcount, 2) = Year
        
     
        Startcol = (Rowob * 3) - 5
        Midcol = (Rowob * 3) - 4
        Endcol = (Rowob * 3) - 3
       
      
    Ddrow = Worksheets("Daily Temps").Range(Temprangename).End(xlDown).Row
    
    Row2 = Ddrow + 2
    Row4 = Ddrow + 4
    Row5 = Ddrow + 5
    Column1 = ColumnLetter(Startcol)
    Column2 = ColumnLetter(Midcol)
    Column3 = ColumnLetter(Endcol)
    Endrow = Worksheets("Daily Temps").Range(Column3 & "65536").End(xlUp).Row
    
    
    
    Mydate = Mymonth & "/" & Myday & "/" & Year
    Datecorrect = 0
    Datecorrect1 = Application.Match(CLng(Mydate), Worksheets("Daily Temps").Range(Column1 & ":" & Column1), 0)
    
    Clearrange = Column1 & Ddrow + 1 & ":" & Column3 & Endrow
    Accform = Column3 & Row4 & "+" & Column2 & Row5
    Startform = Column2 & Row4
    Matchstart = Ddrow + 5
    Matchend = Ddrow + Ddrow + 4
    Fillrange = Column1 & Ddrow + 5 & ":" & Column3 & Ddrow + Ddrow
    Fillstart = Column1 & Ddrow + 5 & ":" & Column3 & Ddrow + 5
    


    If ReCalcDD = False Then
    
     With Worksheets("Daily Temps")
        .Range(Clearrange).Clear
        .Range(Temprangename)(Row2, 1) = "Julian"
        .Range(Temprangename)(Row2, 2) = "Method"
        .Range(Temprangename)(Row2, 3) = "Accl."
        .Range(Temprangename)(Row2, 1)(2, 2) = Method
        .Range(Temprangename)(Row2, 1)(3, 1) = "=Jdate(" & Column1 & "4)"
      .Range(Temprangename)(Row2, 1)(4, 1) = "=Jdate(" & Column1 & "5)"
        
        End With
    
    With Worksheets("Daily Temps").Range(Clearrange).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
     With Worksheets("Daily Temps").Range(Clearrange).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .Weight = xlMedium
    End With
    
   
 
  Select Case Method

  Case Is = "Max_Min"
  With Worksheets("Daily Temps")
  .Range(Temprangename)(Row2, 1)(2, 2) = Method
  .Range(Temprangename)(Row2, 1)(3, 2) = "=maxmindd(" & Column2 & Datecorrect + 4 & "," & Column3 & Datecorrect + 4 & ",Analysis!E$" & Analysisrow & ",Analysis!F$" & Analysisrow & ")"
  .Range(Temprangename)(Row2, 1)(3, 3) = "=" & Startform
  .Range(Temprangename)(Row2, 1)(4, 2) = "=maxmindd(" & Column2 & Datecorrect + 5 & "," & Column3 & Datecorrect + 5 & ",Analysis!E$" & Analysisrow & ",Analysis!F$" & Analysisrow & ")"
  .Range(Temprangename)(Row2, 1)(4, 3) = "=" & Accform
  
  End With

  Case Is = "Sine_Wave"
  With Worksheets("Daily Temps")
  .Range(Temprangename)(Row2, 1)(2, 2) = Method
  .Range(Temprangename)(Row2, 1)(3, 2) = "=sindd(" & Column3 & Datecorrect + 4 & "," & Column3 & Datecorrect + 5 & "," & Column2 & Datecorrect + 4 & ",Analysis!E$" & Analysisrow & ",Analysis!F$" & Analysisrow & ")"
  .Range(Temprangename)(Row2, 1)(3, 3) = "=" & Startform
  .Range(Temprangename)(Row2, 1)(4, 2) = "=sindd(" & Column3 & Datecorrect + 4 & "," & Column3 & Datecorrect + 5 & "," & Column2 & Datecorrect + 4 & ",Analysis!E$" & Analysisrow & ",Analysis!F$" & Analysisrow & ")"
  .Range(Temprangename)(Row2, 1)(4, 3) = "=" & Accform
  End With
    End Select

    Worksheets("Daily Temps").Range(Fillstart).AutoFill Destination:=Worksheets("Daily Temps").Range(Fillrange), Type:=xlFillDefault
 
    GDD25 = Application.Index(Worksheets("Daily Temps").Range(Column3 & Matchstart & ":" & Column3 & Matchend), Application.Match(Worksheets("Observed Flight").Range("G" & Myrow).Value, Worksheets("Daily Temps").Range(Column1 & Matchstart & ":" & Column1 & Matchend)))
    GDD50 = Application.Index(Worksheets("Daily Temps").Range(Column3 & Matchstart & ":" & Column3 & Matchend), Application.Match(Worksheets("Observed Flight").Range("H" & Myrow).Value, Worksheets("Daily Temps").Range(Column1 & Matchstart & ":" & Column1 & Matchend)))
    GDD75 = Application.Index(Worksheets("Daily Temps").Range(Column3 & Matchstart & ":" & Column3 & Matchend), Application.Match(Worksheets("Observed Flight").Range("I" & Myrow).Value, Worksheets("Daily Temps").Range(Column1 & Matchstart & ":" & Column1 & Matchend)))


Application.StatusBar = FormatPercent(Analysisrow / Analysisendrow, 0)


Else:
GDDcorrect = Application.Index(Worksheets("Daily Temps").Range(Column3 & Matchstart & ":" & Column3 & Matchend), Application.Match(Julianstart - 1, Worksheets("Daily Temps").Range(Column1 & Matchstart & ":" & Column1 & Matchend)))
    GDD25 = Application.Index(Worksheets("Daily Temps").Range(Column3 & Matchstart & ":" & Column3 & Matchend), Application.Match(Worksheets("Observed Flight").Range("G" & Myrow).Value, Worksheets("Daily Temps").Range(Column1 & Matchstart & ":" & Column1 & Matchend))) - GDDcorrect
    GDD50 = Application.Index(Worksheets("Daily Temps").Range(Column3 & Matchstart & ":" & Column3 & Matchend), Application.Match(Worksheets("Observed Flight").Range("H" & Myrow).Value, Worksheets("Daily Temps").Range(Column1 & Matchstart & ":" & Column1 & Matchend))) - GDDcorrect
    GDD75 = Application.Index(Worksheets("Daily Temps").Range(Column3 & Matchstart & ":" & Column3 & Matchend), Application.Match(Worksheets("Observed Flight").Range("I" & Myrow).Value, Worksheets("Daily Temps").Range(Column1 & Matchstart & ":" & Column1 & Matchend))) - GDDcorrect

End If

    tot25 = tot25 + GDD25
    tot50 = tot50 + GDD50
    tot75 = tot75 + GDD75
    
    
    Next Myrow
 

    Avg25 = tot25 / (Observedendrow - 2 - undercatch - blank)
    Avg50 = tot50 / (Observedendrow - 2 - undercatch - blank)
    Avg75 = tot75 / (Observedendrow - 2 - undercatch - blank)

    Avg25 = WorksheetFunction.Round(Avg25, 0)
    Avg50 = WorksheetFunction.Round(Avg50, 0)
    Avg75 = WorksheetFunction.Round(Avg75, 0)
    
    tot25 = 0
    tot50 = 0
    tot75 = 0

    jObservedendrow = Sheets("Observed Flight").Range("A2:C2").End(xlDown).Row
    Errorcount = 0
    
    If Sheets("Analysis").Range("J" & Analysisrow) = "Model" Then
    Avg25 = 1319
    Avg50 = 1422
    Avg75 = 1536
    End If


    Sheets("Analysis").Range("G" & Analysisrow) = Avg25
    Sheets("Analysis").Range("H" & Analysisrow) = Avg50
    Sheets("Analysis").Range("I" & Analysisrow) = Avg75
    

    
   For jMyrow = 3 To jObservedendrow



Catchpoint3:
        jLocation = Sheets("Observed Flight").Cells(jMyrow, 1)
        jYear = Sheets("Observed Flight").Cells(jMyrow, 2)
        jTemprangename = jLocation & "_" & jYear

         If Worksheets("Daily Temps").Range(jTemprangename)(1, 3) = "Catch" Then
        jMyrow = jMyrow + 1
        Errorcount = Errorcount + 1
         GoTo Catchpoint3
        End If
        jRowob = jMyrow - 1
        jStartcol = (jRowob * 3) - 5
        jMidcol = (jRowob * 3) - 4
        jEndcol = (jRowob * 3) - 3
        

    jColumn1 = ColumnLetter(jStartcol)
    jColumn2 = ColumnLetter(jMidcol)
    jColumn3 = ColumnLetter(jEndcol)




   'Finds predicted date based on average GDD on observed dates for specified method and thresholds.

    jday = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn3 & Matchstart & ":" & jColumn3 & Matchend), Application.Match(Avg25, Worksheets("Daily Temps").Range(jColumn3 & Matchstart & ":" & jColumn3 & Matchend)))
    Select Case jday
    Case Is < Avg25
    Predict25 = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn1 & ":" & jColumn1), Application.Match(Avg25, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)) + 1)
    Case Is = Avg25
    Predict25 = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn1 & ":" & jColumn1), Application.Match(Avg25, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)))
   End Select

    jday = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3), Application.Match(Avg50, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)))
    Select Case jday
    Case Is < Avg50
    Predict50 = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn1 & ":" & jColumn1), Application.Match(Avg50, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)) + 1)
    Case Is = Avg50
    Predict50 = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn1 & ":" & jColumn1), Application.Match(Avg50, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)))
   End Select

    jday = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3), Application.Match(Avg75, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)))
    Select Case jday
    Case Is < Avg75
    Predict75 = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn1 & ":" & jColumn1), Application.Match(Avg75, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)) + 1)
    Case Is = Avg75
    Predict75 = WorksheetFunction.Index(Worksheets("Daily Temps").Range(jColumn1 & ":" & jColumn1), Application.Match(Avg75, Worksheets("Daily Temps").Range(jColumn3 & ":" & jColumn3)))
   End Select

    Predict25Array(jRowob - Errorcount, Analysisrow2) = Predict25
    Predict50Array(jRowob - Errorcount, Analysisrow2) = Predict50
    Predict75Array(jRowob - Errorcount, Analysisrow2) = Predict75

    Next jMyrow

  Next Analysisrow
  
  
  Call ArrayToCSV(Predict25Array, "C:\Users\Documents\Program Files\predict25.txt", ",")
  Call ArrayToCSV(Predict50Array, "C:\Users\Documents\Program Files\predict50.txt", ",")
  Call ArrayToCSV(Predict75Array, "C:\Users\Documents\Program Files\predict75.txt", ",")
  
 Worksheets("Analysis").Range("K29") = Timer - Benchmark
 Application.ScreenUpdating = True
 Application.StatusBar = ""
Application.Calculation = xlManual
End Sub

There's a bit of a worksheet setup to be able to actually use this, so I don't expect anyone to be going and testing it out. Basically the analysisrow variable is meant to represent one row of data in excel, and the calculations for each row are done between the analysisrow loop. If I either run this multiple times on the same short section of the data set, or the entire set of rows, the calculation time increases after each loop.

 

[kingofaces]

So I guess to clarify further, is there something that is stored in the background when you run a macro that remains stored until you close Excel? I haven't had this issue about before, so I'm trying to go back through pieces of it and see if I can spot what did it.

 

[Cindy Ellis]

I've seen similar behavior before when processing thousands of files sequentially in a loop in a single macro, but not when re-running the macro. You might consider looking at Windows task manager to see what the memory and CPU usage is as the macro runs repeatedly.
The only other thing I noticed is that calculation is "Auto" during the macro, and set to "Manual" at the end. If the file is getting larger and larger as the macro is run repeatedly, that could explain at least some of the slowdown.
Hope that helps at least a little bit,..