It's difficult to recreate your code environment so at a glance can't
suggest what might cause code to stop, in particular with the automated
instance in Design mode. Perhaps there's something you know about that might
be causing that.
You say other workbooks are still open, presumably they shouldn't be so that
should be easy to track down.
Instead of opening in an automated instance why not open in the same
instance, simply change
'Set myXLApplication = New Excel.Application
Set myXLApplication = Application
Guessing, are you opening several similar workbooks each with similar OnTime
code, if so that's going to cause loads of confusion.
Regards,
Peter T
Hello Peter
By stopping I mean it just sort of drops out i.e no error occurs but
the program just stops at the point I mentioned. When I then look in
the instance of Excel, the workbook with the code in it is open with
the Design Mode button activated and all other books that the program
has opened upto that point are also open ! Because there isn't an
error generated I had a lot of trouble finding exactly where it was
stopping - that is why I added a lot of Debug.Print labels throughout
the program.
Here's the automation Peter (quite a lot of it!! ....you might have
seen some of it before in my previous posts)......
In Excel1:
'================================
'================================
Option Explicit
Public myXLApplication As Excel.Application
Public myXLWorkbook As Excel.Workbook
Public Const myCodeWorkbook As String = "R:\Statistics\Daily Storage
Book Updater.xlsm"
Sub UpdateStorageBooks()
Application.EnableEvents = True
Set myXLApplication = New Excel.Application
myXLApplication.Visible = True
myXLApplication.Workbooks.Open myCodeWorkbook, , False, , , , True
Set myXLApplication = Nothing
End Sub
'================================
'================================
.........then in the second instance the following runs:
Option Explicit
Private Sub Workbook_Open()
Dim ActionTime As Date
ActionTime = Now() + TimeValue("00:00:10")
Application.OnTime ActionTime, "controlRoutine"
End Sub 'Workbook_Open
'================================
'================================
.............then 10 seconds later the following runs.........
Sub controlRoutine()
blUpdateAll = False
Application.ScreenUpdating = True
If MsgBox("Do you wish to update all storage sheets irrespective
as to whether they have already been saved today?", vbYesNo +
vbDefaultButton2, "Overwrite Existing Files") = vbYes Then
Application.ScreenUpdating = False
blUpdateAll = True
End If
Application.ScreenUpdating = False
blUpdateFormatting = False
Application.ScreenUpdating = True
If MsgBox("Do you wish to update sheet formatting?", vbYesNo +
vbDefaultButton2, "Update formatting") = vbYes Then
Application.ScreenUpdating = False
blUpdateFormatting = True
End If
Application.ScreenUpdating = False
Call UpdateFeedWorkbook
Call UpdateStorageBooksAndSummary
Application.ScreenUpdating = True
MsgBox "Completed Routine!"
End Sub 'controlRoutine
'================================
'================================
..............in the above it is stopping part way through a big loop
in the routine "UpdateStorageBooksAndSummary" which contains the
following.........
Public Sub UpdateStorageBooksAndSummary()
Application.ScreenUpdating = False
'========open the summary file
'open summary file
If IsFileOpen(ExtractFileName(mySummaryFilePath)) = False Then
Workbooks.Open mySummaryFilePath, , False, , , , True
End If
Set mySummaryBook = Workbooks(ExtractFileName
(mySummaryFilePath))
'========
'clear out the data sheets that were previously collated
from the storage sheets
With mySummaryBook
.Sheets("Data_Measures").Range("A2:AZ10000").ClearContents
.Sheets("Data_MaxMin").Range("A2:AZ10000").ClearContents
.Sheets("Data_Graphs").Range("A4:G10000").ClearContents
.Sheets("Data_Graphs").Range("J4:M10000").ClearContents
.Sheets("Data_Graphs").Range("P4:R10000").ClearContents
End With
'========
'========open the feed file
'open feed file
If IsFileOpen(ExtractFileName(myFeedFilePath)) = False Then
Workbooks.Open myFeedFilePath, , False, , , , True
End If
Set myFeedBook = Workbooks(ExtractFileName(myFeedFilePath))
'========
'========open all storage sheets
i = 1
EndCell = ThisWorkbook.Sheets("Static_Data").Range("C100").End
(xlUp).Row
'loop through the category names, which correspond to the
storage book names
'For Each oItem In oPivCatRange.Cells
For j = 6 To EndCell
myItem = ThisWorkbook.Sheets("Static_Data").Cells(j,
3).Value
myStorageName = myItem & ".xlsx"
If myItem <> "" Then
'check if NOT saved today;
AlreadyUpdated = False
If FileDateTime(myStorageFileStore &
myStorageName) > Date And blUpdateAll = False Then
AlreadyUpdated = True
End If
Debug.Print "1A" '++++++++
Debug.Print myStorageFileStore & myStorageName '++++++++
Debug.Print Application.ScreenUpdating '++++++++
Debug.Print Application.Calculation '++++++++
'=======open each Storage book - always
opens file to move data to summary
Dim myStorageFullPathWay As String
myStorageFullPathWay =
myStorageFileStore & myStorageName
Debug.Print "1B" '++++++++
With Application
.EnableEvents = False
.ScreenUpdating = True
.Calculation = xlCalculationManual
Debug.Print "1Bx" '++++++++
ChDir myStorageFileStore
Debug.Print "1By" '++++++++
.Workbooks.Open CStr
(myStorageFullPathWay), , False, , , , True
Debug.Print "1Bz" '++++++++
.Calculation =
xlCalculationAutomatic
.ScreenUpdating = False
.EnableEvents = True
End With
Debug.Print "1C" '++++++++
' Dim my As String
Set myStorageBook = Workbooks
(myStorageName)
'=======clear out old data if not
already updated
If AlreadyUpdated = True Then
Else
With myStorageBook.Sheets("Input")
.Range
("C6:AZ500").ClearContents
.Range("D2").ClearContents
End With
End If
'=========================================
'=======copy data into Storage sheet
If AlreadyUpdated = True Then
Else
With myFeedBook.Sheets("Pivot")
.Range("E3").Value = myItem
myLastRow = .Cells
(Rows.Count, 4).End(xlUp).Row
Set rSource = .Range("D7
"
& myLastRow)
Set rDest =
myStorageBook.Sheets("Input").Range("C7")
With rSource
Set rDest =
rDest.Resize(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
Set rSource = .Range("B6:B"
& myLastRow)
Set rDest =
myStorageBook.Sheets("Input").Range("D6")
With rSource
Set rDest =
rDest.Resize(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
Set rSource = .Range("E6:AZ"
& myLastRow)
Set rDest =
myStorageBook.Sheets("Input").Range("E6")
With rSource
Set rDest =
rDest.Resize(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
Set rSource =
Nothing '#########################NEW
19AUG09
Set rDest =
Nothing
'#########################NEW 19AUG09
End With
End If
'=========================================
'=======copy data out of Storage
sheet==========
With Workbooks(myStorageName).Sheets
("Summary")
.Activate
Set rSource = .Range("C5:BG"
& .Range("B46").Value + 4)
Set rDest = mySummaryBook.Sheets
("Data_Measures").Cells(Rows.Count, 4).End(xlUp)(2, 1)
With rSource
Set rDest = rDest.Resize
(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
Set rSource =
Nothing '#########################NEW
19AUG09
Set rDest =
Nothing
'#########################NEW 19AUG09
End With
With mySummaryBook.Sheets
("Data_Measures")
.Range("B" & .Cells(.Rows.Count,
2).End(xlUp).Row + 1 & ":B" & .Cells(.Rows.Count, 4).End(xlUp).Row) =
Workbooks(myStorageName).Sheets("Summary").Range("C2").Value
.Range("C" & .Cells(.Rows.Count,
3).End(xlUp).Row + 1 & ":C" & .Cells(.Rows.Count, 4).End(xlUp).Row) =
myItem
End With
'=======
'copy graph data out of Storage sheet
With Workbooks(myStorageName).Sheets
("All Operator")
.Activate
'#########################NEW 19AUG09
Set rSource = .Range
("AH7:AL43")
Set rDest =
mySummaryBook.Sheets("Data_Graphs").Cells(mySummaryBook.Sheets
("Data_Graphs").Rows.Count, 3).End(xlUp)(2, 1)
With rSource
Set rDest =
rDest.Resize(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
Set rSource = Nothing
Set rDest = Nothing
Set rSource = .Range
("AJ6:AL6")
Set rDest =
mySummaryBook.Sheets("Data_Graphs").Cells(mySummaryBook.Sheets
("Data_Graphs").Rows.Count, 11).End(xlUp)(2, 1)
With rSource
Set rDest =
rDest.Resize(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
Set rSource = Nothing
Set rDest = Nothing
Set rSource = .Range
("Y6:Z136")
Set rDest =
mySummaryBook.Sheets("Data_Graphs").Cells(mySummaryBook.Sheets
("Data_Graphs").Rows.Count, 17).End(xlUp)(2, 1)
With rSource
Set rDest =
rDest.Resize(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
Set rSource =
Nothing '#########################NEW
19AUG09
Set rDest =
Nothing
'#########################NEW 19AUG09
End With
With mySummaryBook.Sheets("Data_Graphs")
.Range("B" & .Cells(.Rows.Count,
2).End(xlUp).Row + 1 & ":B" & .Cells(.Rows.Count, 3).End(xlUp).Row) =
myItem
.Range("J" & .Cells(.Rows.Count,
10).End(xlUp).Row + 1 & ":J" & .Cells(.Rows.Count, 11).End(xlUp).Row)
= myItem
.Range("P" & .Cells(.Rows.Count,
16).End(xlUp).Row + 1 & "
" & .Cells(.Rows.Count, 17).End(xlUp).Row)
= myItem
End With
'=========================================
'=======format each sheet in data
storage book==========
If AlreadyUpdated = True Then
Else
If blUpdateFormatting = True Then
'#########################NEW 20AUG09
myStorageBook.Activate
For Each mySheet In
myStorageBook.Worksheets
'check to
see if the storage sheet is being used
'if it
isn't then delete it
If mySheet.Name
<> "Input" And mySheet.Name <> "Summary" Then
With
mySheet
.Activate
' .Calculate
End With
If
mySheet.Range("C2").Value = "Empty" Then
Application.DisplayAlerts = False
mySheet.Delete
Application.DisplayAlerts = True
Else
mySheet.Range
("D:G,J:L,N:N,O
,T:T,Z:AB,AJ:AL,AO:AQ,AU:AV").EntireColumn.AutoFit
End If
End If
Next
End If
'#########################NEW 20AUG09
End If
'=====only save the storage sheets if
necessary========
If AlreadyUpdated = True Then
myStorageBook.Close False
Else
myStorageBook.Sheets
("Input").Activate
With Application
.ScreenUpdating =
True
.EnableEvents = True
.Calculation =
xlCalculationAutomatic
End With
myStorageBook.Close True
End If
Set myStorageBook = Nothing
'=======
End If
Next j
'========
Set myStorageBook = Nothing '++++++++new
'========tidy up the summary file and then close it
With mySummaryBook.Sheets("Data_Measures")
.Range("A2").FormulaR1C1 = "=RC[1]&RC[2]&RC[3]"
.Range("A2").AutoFill Destination:=.Range("A2:A" & .Cells
(.Rows.Count, 2).End(xlUp).Row)
Set rSource = .Range("A2:A" & .Cells(.Rows.Count, 2).End
(xlUp).Row)
Set rDest = .Range("A2:A" & .Cells(.Rows.Count, 2).End
(xlUp).Row)
With rSource
Set rDest = rDest.Resize
(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
End With
With mySummaryBook.Sheets("Data_Graphs")
.Range("A4").FormulaR1C1 = "=RC[1]&RC[2]"
.Range("A4").AutoFill Destination:=.Range("A4:A" & .Cells
(.Rows.Count, 2).End(xlUp).Row)
Set rSource = .Range("A4:A" & .Cells(.Rows.Count, 2).End
(xlUp).Row)
Set rDest = .Range("A4:A" & .Cells(.Rows.Count, 2).End
(xlUp).Row)
With rSource
Set rDest = rDest.Resize
(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
End With
With mySummaryBook.Sheets("Data_Available")
.Range("F4:F100").ClearContents
.PivotTables("PivotTable2").PivotCache.Refresh
Set rSource = .Range(.Cells(5, 14), .Cells(.Cells
(.Rows.Count, 14).End(xlUp).Row, 14))
Set rDest = .Range("F4")
End With
With rSource
Set rDest = rDest.Resize(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
mySummaryBook.Sheets("Data_Available").PivotTables
("PivotTable1").PivotCache.Refresh
mySummaryBook.Sheets(1).Activate
mySummaryBook.Close True
'===========
'===========
Workbooks(ExtractFileName(myFeedFilePath)).Close False
ThisWorkbook.Sheets("Static_Data").Activate
Set rSource = Nothing '=+++++++++
Set rDest = Nothing '++++++++++++
Set mySummaryBook = Nothing
Set oPivCatRange = Nothing
Application.ScreenUpdating = True
End Sub
'================================
'================================
Any help much appreciated
Jason.
