I have a macro that is called from the before save event:
Sub ToGlobal()
ThisWorkbook.Activate
Dim strSheet As String
strSheet = Range("TargetSheet").Value
Dim StartPst As String
StartPst = Range("CV").Value
ActiveWorkbook.Worksheets(1).Activate
ActiveSheet.Unprotect Password:="TP"
Application.ScreenUpdating = False
Range("A42:AJ48").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1:AJ7").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.ScreenUpdating = False
ActiveSheet.Protect Password:="TP", DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
ActiveSheet.EnableSelection = xlNoRestrictions
Range("BB37").Select
Selection.Copy
Application.ScreenUpdating = True
Dim myFile As String, myFolder As String
myFolder = Range("Filepath")
myFile = myFolder & Range("Filename")
If Not IsFolderExists(myFolder) Then
CreateObject("Scripting.FileSystemObject").CreateFolder myFolder
End If
If Not IsFileExists(myFile) Then
MsgBox "The folder path & file " & myFile & " could not be found and the global TP cannot be updated."
UserForm1.Hide
Exit Sub
End If
If ActiveWorkbook.Saved = False And ActiveWorkbook.ReadOnly = False Then
UserForm1.Show
UserForm1.Repaint
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(1).Activate
Range("A3:AJ7").Select
Selection.Copy
Dim CurrentGlobal As String
CurrentGlobal = Replace(Range("Filename"), "\", "")
Workbooks.Open Filename:=Range("FullName").Text, WriteResPassword:="GTP"
If ActiveWorkbook.ReadOnly = True Then
UserForm1.Hide
MsgBox "Another user has the global TP open. Could not update- please click save again to update the global TP"
ActiveWorkbook.Close
Application.DisplayAlerts = True
Exit Sub
End If
ActiveWorkbook.Worksheets(strSheet).Activate
Range(StartPst).Select
ActiveWorkbook.Worksheets(strSheet).Paste
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.Save
ActiveWindow.Close
Application.DisplayAlerts = True
Range("B3").Select
UserForm1.Hide
End If
End Sub
The macro runs fine when the user clicks save, and also if the user closes the workbook and selects save changes.
However, I have an on time macro which saves and then closes the workbook programatically after 30 seconds. When this happens, the 'ToGlobal' macro run, but breaks at the following point:
ActiveWorkbook.Worksheets(strSheet).Activate
I have found that the 'subscript out of range' error is beause the workbook whose name is contained in the range "FullName" has not been opened.
I have tried replacing the range with the full filepath of the workbook I want to open, but the same thing happens, and I have tried placing the 'ToGlobal' code directly in the before save event.
What I have found however, is that I place the code of the ToGlobal macro directly in the macro that the OnTime calls every 30 seconds, the code from ToGlobal runs fine without a break. However, I can't use that as a solution as that macro also needs to shut down the containing workbook.