Out of Memory Error (w/ code reference)

[tjiddy89]

Good evening everyone! I'm needing help again with my code because it is now giving me an out of memory error. I've been researching this error for the past few days and the only thing that I've found that remotely helped was saving the file after every few sections. Please see below for referenced code. Any feedback is greatly appreciated as always.

Sub updateTeam()

    ' -------------------------------
    '  DO NOT MODIFY THIS SECTION
    ' -------------------------------
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    
    ' -------------------------------
    '  Variable definitions
    ' -------------------------------
    Dim team As String, john As String
    
    'Sets up team definition
    team = "Team Metrics"
    
    'Sets up agent definition
    john = "John Doe"
    
    Workbooks(team).Worksheets(1).Range("R1").Value = Date
    perComp (0)
    TeamProgress.Show
    
    ' -------------------------------
    '  John Doe
    ' -------------------------------
    
    ' Changes the label of the progress bar.
    TeamProgress.StatusLabel.Caption = "Now updating John Doe.  Please wait..."
    
    ' Annotates the date the referenced document was modified last.
    Workbooks(team).Worksheets(1).Range("R5") = Int(FileDateTime("C:\Users\owner\Desktop\Projects\Metrics\Agent QC Files\John Doe.xlsm"))
    
    ' Opens the agent's metrics spreadsheet in the background
    Workbooks.Open ("C:\Users\owner\Desktop\Projects\Metrics\Agent QC Files\John Doe.xlsm")
    
    ' If agent's metrics spreadsheet was not updated today then it updates the agent's metrics
    If (Workbooks(team).Worksheets(1).Range("R6").Value <> Date) Then
        'Application.Run ("'John Doe.xlsm'!updateAgent")
    End If
    
    ' Pulls data from the agent's metrics spreadsheet into the Team Overview spreadsheet
    Workbooks(team).Worksheets(1).Range("C5") = Workbooks(john).Worksheets(1).Range("C18")
    Workbooks(team).Worksheets(1).Range("D5") = Workbooks(john).Worksheets(1).Range("D17")
    Workbooks(team).Worksheets(1).Range("E5") = Workbooks(john).Worksheets(1).Range("E17")
    Workbooks(team).Worksheets(1).Range("F5") = Workbooks(john).Worksheets(1).Range("F17")
    Workbooks(team).Worksheets(1).Range("G5") = Workbooks(john).Worksheets(1).Range("G18")
    Workbooks(team).Worksheets(1).Range("H5") = Workbooks(john).Worksheets(1).Range("H18")
    Workbooks(team).Worksheets(1).Range("I5") = Workbooks(john).Worksheets(1).Range("I18")
    Workbooks(team).Worksheets(1).Range("J5") = Workbooks(john).Worksheets(1).Range("J18")
    Workbooks(team).Worksheets(1).Range("K5") = Workbooks(john).Worksheets(1).Range("K18")
    Workbooks(team).Worksheets(1).Range("L5") = Workbooks(john).Worksheets(1).Range("L18")
    Workbooks(team).Worksheets(1).Range("M5") = Workbooks(john).Worksheets(1).Range("M18")
    
    ' Closes agent metrics spreadsheet and saves the spreadsheet only if new data was pulled.  If not is doesn't save it.
    If (Workbooks(team).Worksheets(1).Range("R6").Value <> Date) Then
        Workbooks(john).Close Savechanges:=True
    ElseIf (Workbooks(team).Worksheets(1).Range("R6").Value = Date) Then
        Workbooks(john).Close Savechanges:=False
    End If
    
    ActiveWorkbook.Save
    
    ' Updates the progress percentage bar.
    perComp (0.06)

This macro goes on to update and THEN pull the data into the active workbook. After the data pulls are performed, it inserts functions into the total/average cells at the bottom. Afterwards, I created a data validation where if the value of a column is equal to zero (or blank) it changes certain cells to "-". If need be I can send a zip file via email to you for further reference.

 

[RoryA]

If need be I can send a zip file via email to you for further reference.

We do not really like passing information by email - can you put the file on a hosting site like Dropbox or OneDrive and add a link here?