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