Out of Memory Error (w/ code reference)

tjiddy89

New Member
Joined
Mar 7, 2018
Messages
20
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.

Code:
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.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
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?
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,876
Members
452,363
Latest member
merico17

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
Back
Top