W
WhytheQ
Hello All,
I've posted about this previously but still haven't solved the problem
- really banging my head against a brock wall!
I've got a large program which runs in a second instance of Excel. It
doesn't bug out but just stops part way though - when I open the
second instance there will be a workbook open in design mode.
How do I go about finding the problem?
Any help much appreciated
Jason
'======================================
here's the code (....there's quite a bit!)..........
Option Explicit
Private Const mySummaryStem As String = "R:\Statistics\Reporting\Daily
Summary\Daily summary 0.4\"
Private Const myStorageFileStore As String = "R:\Statistics\Reporting
\Daily Summary\Daily summary 0.4\Data Storage Sheets 0.4\"
Private Const mySummaryFilePath As String = "R:\Statistics\Reporting
\DailySummary\Daily summary 0.4\Daily Casino Summary 0.4.xlsm"
Private Const myStorageTemplatePath As String = "R:\Statistics
\Reporting\Daily Summary\Daily summary 0.4\Daily Storage Template
0.4.xlsx"
Private Const myFeedFilePath As String = "R:\Statistics\Reporting
\Daily Summary\Daily summary 0.4\Daily Feed 0.4.xlsm"
Private myFeedBook As Workbook
Private rSource As Range
Private rDest As Range
Private AlreadyUpdated As Boolean
Private blUpdateAll As Boolean
Private blUpdateFormatting As Boolean
Private blSaveStorageSheet As Boolean
Private oPivCatRange As Range
'Private oItem
'Private oItem As String
Private myItem As String
Private myStorageName As String
Private EndCell As Integer
Private j As Integer
Private myLastRow
Private myStorageBook As Workbook
Private mySheet As Worksheet
Private mySummaryBook As Workbook
Private i As Integer
Public Sub UpdateFeedWorkbook()
Application.ScreenUpdating = False
Set myFeedBook = Workbooks.Open(myFeedFilePath, , False, , , ,
True)
With myFeedBook
.Sheets("Daily_QueryTable").ListObjects
(1).QueryTable.Refresh BackgroundQuery:=False
.Sheets("Pivot").PivotTables
("PivotTable3").PivotCache.Refresh
.Sheets("Pivot2").PivotTables
("PivotTable1").PivotCache.Refresh
Set rSource = .Sheets("Pivot2").Range("C5:C"
& .Sheets("Pivot2").Cells(.Sheets("Pivot2").Rows.Count, 3).End
(xlUp).Row)
Set rDest = ThisWorkbook.Sheets("Static_Data").Range
("S6")
With rSource
Set rDest = rDest.Resize
(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
End With
Set myFeedBook = Nothing
Application.ScreenUpdating = True
End Sub
Public Sub UpdateStorageBooksAndSummary()
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
'========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
'look at the category names in the pivot on the Control sheet
'With ThisWorkbook.Sheets("Static_Data")
' Set oPivCatRange = .Range("StorageSheetsToUpdate")
'End With
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
'=======open each Storage book - always opens
file to move data to summary
Set myStorageBook = Workbooks.Open
(myStorageFileStore & myStorageName) ', , False, , , , True
'=======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")
Application.ScreenUpdating =
True '#########################NEW 21AUG09
.Range("E3").Value = myItem
Application.ScreenUpdating =
False '#########################NEW 21AUG09
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
Application.ScreenUpdating =
True '#########################NEW 21AUG09
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 = .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 = .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
Application.ScreenUpdating =
False '#########################NEW 21AUG09
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
' On Error Resume Next
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
' On Error GoTo 0
' myStorageBook.Sheets("All
Operator").Activate
End If
'=====only save the storage sheets if
necessary========
If AlreadyUpdated = True Then
myStorageBook.Close False
Else
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
End Sub
Private Function IsFileOpen(strFile As String) As Boolean
Dim aName As String
On Error GoTo NotOpen:
aName = Workbooks(strFile).Name
IsFileOpen = True
GoTo FunctionEnd:
NotOpen:
IsFileOpen = False
FunctionEnd:
End Function 'IsFileOpen
Public Function ExtractFileName(ByVal strFullName As String) As String
Dim p As Integer
Dim i As Integer
Dim s As Integer
i = 1
Do
p = InStr(i, strFullName, "\", 1)
If p = 0 Then Exit Do
s = p
i = p + 1
Loop
s = s + 1
ExtractFileName = Mid(strFullName, s, Len(strFullName))
End Function
I've posted about this previously but still haven't solved the problem
- really banging my head against a brock wall!
I've got a large program which runs in a second instance of Excel. It
doesn't bug out but just stops part way though - when I open the
second instance there will be a workbook open in design mode.
How do I go about finding the problem?
Any help much appreciated
Jason
'======================================
here's the code (....there's quite a bit!)..........
Option Explicit
Private Const mySummaryStem As String = "R:\Statistics\Reporting\Daily
Summary\Daily summary 0.4\"
Private Const myStorageFileStore As String = "R:\Statistics\Reporting
\Daily Summary\Daily summary 0.4\Data Storage Sheets 0.4\"
Private Const mySummaryFilePath As String = "R:\Statistics\Reporting
\DailySummary\Daily summary 0.4\Daily Casino Summary 0.4.xlsm"
Private Const myStorageTemplatePath As String = "R:\Statistics
\Reporting\Daily Summary\Daily summary 0.4\Daily Storage Template
0.4.xlsx"
Private Const myFeedFilePath As String = "R:\Statistics\Reporting
\Daily Summary\Daily summary 0.4\Daily Feed 0.4.xlsm"
Private myFeedBook As Workbook
Private rSource As Range
Private rDest As Range
Private AlreadyUpdated As Boolean
Private blUpdateAll As Boolean
Private blUpdateFormatting As Boolean
Private blSaveStorageSheet As Boolean
Private oPivCatRange As Range
'Private oItem
'Private oItem As String
Private myItem As String
Private myStorageName As String
Private EndCell As Integer
Private j As Integer
Private myLastRow
Private myStorageBook As Workbook
Private mySheet As Worksheet
Private mySummaryBook As Workbook
Private i As Integer
Public Sub UpdateFeedWorkbook()
Application.ScreenUpdating = False
Set myFeedBook = Workbooks.Open(myFeedFilePath, , False, , , ,
True)
With myFeedBook
.Sheets("Daily_QueryTable").ListObjects
(1).QueryTable.Refresh BackgroundQuery:=False
.Sheets("Pivot").PivotTables
("PivotTable3").PivotCache.Refresh
.Sheets("Pivot2").PivotTables
("PivotTable1").PivotCache.Refresh
Set rSource = .Sheets("Pivot2").Range("C5:C"
& .Sheets("Pivot2").Cells(.Sheets("Pivot2").Rows.Count, 3).End
(xlUp).Row)
Set rDest = ThisWorkbook.Sheets("Static_Data").Range
("S6")
With rSource
Set rDest = rDest.Resize
(.Rows.Count, .Columns.Count)
End With
rDest.Value = rSource.Value
End With
Set myFeedBook = Nothing
Application.ScreenUpdating = True
End Sub
Public Sub UpdateStorageBooksAndSummary()
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
'========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
'look at the category names in the pivot on the Control sheet
'With ThisWorkbook.Sheets("Static_Data")
' Set oPivCatRange = .Range("StorageSheetsToUpdate")
'End With
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
'=======open each Storage book - always opens
file to move data to summary
Set myStorageBook = Workbooks.Open
(myStorageFileStore & myStorageName) ', , False, , , , True
'=======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")
Application.ScreenUpdating =
True '#########################NEW 21AUG09
.Range("E3").Value = myItem
Application.ScreenUpdating =
False '#########################NEW 21AUG09
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
Application.ScreenUpdating =
True '#########################NEW 21AUG09
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 = .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 = .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
Application.ScreenUpdating =
False '#########################NEW 21AUG09
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
' On Error Resume Next
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.AutoFitEnd If
End If
Next
End If
'#########################NEW 20AUG09
' On Error GoTo 0
' myStorageBook.Sheets("All
Operator").Activate
End If
'=====only save the storage sheets if
necessary========
If AlreadyUpdated = True Then
myStorageBook.Close False
Else
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
End Sub
Private Function IsFileOpen(strFile As String) As Boolean
Dim aName As String
On Error GoTo NotOpen:
aName = Workbooks(strFile).Name
IsFileOpen = True
GoTo FunctionEnd:
NotOpen:
IsFileOpen = False
FunctionEnd:
End Function 'IsFileOpen
Public Function ExtractFileName(ByVal strFullName As String) As String
Dim p As Integer
Dim i As Integer
Dim s As Integer
i = 1
Do
p = InStr(i, strFullName, "\", 1)
If p = 0 Then Exit Do
s = p
i = p + 1
Loop
s = s + 1
ExtractFileName = Mid(strFullName, s, Len(strFullName))
End Function