Private Sub Workbook_Open()

If Now() < 0.25 * ThisWorkbook.Sheet1.Range("A1").Value Then Exit Sub

Resp = MsgBox("Save Archive? .", vbYesNo)

If Resp = vbYes Then

Dim wb As Workbook


'----Saving Part
Dim newFileName As String
Application.DisplayAlerts = False
    
    
       newFileName = "Fix It Report Archive" & Format(Now, " MM-DD HHMM") & ".xlsm"
       
    
ActiveWorkbook.SaveAs Filename:="M:\My Folder\Karen Postiglioni\JP\Template REPORTS\Tool Archives\\" & newFileName

 Workbooks.Open Filename:= _
        "M:\My Folder\Karen Postiglioni\JP\Template REPORTS\Template QA2.xlsm"
        
For Each wb In Workbooks
If Left(wb.Name, 21) = "Fix It Report Archive" Then
wb.Close
End If
Next

Application.DisplayAlerts = True
Windows("Template QA2").Activate
ThisWorkbook.Sheet1.Range("A1").Value = Now()

End If