Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can't find bug because program justs Stops !!
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.Cou nt, 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").Clear Contents .Sheets("Data_MaxMin").Range("A2:AZ10000").ClearCo ntents .Sheets("Data_Graphs").Range("A4:G10000").ClearCon tents .Sheets("Data_Graphs").Range("J4:M10000").ClearCon tents .Sheets("Data_Graphs").Range("P4:R10000").ClearCon tents 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").E nd (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:D" & 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_G raphs").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_G raphs").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_G raphs").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 & ":P" & .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:P,T:T,Z:AB,AJ:AL,AO:AQ,AU:AV").Ent ireColumn.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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can't find bug because program justs Stops !!
Jason
The method I tend to use is to 'step into the code' using F8 or 'Debug, Step Into'. This way you can execute the code one row at a time and hopefully find out where it's going wrong. Mart "WhytheQ" wrote: 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.Cou nt, 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").Clear Contents .Sheets("Data_MaxMin").Range("A2:AZ10000").ClearCo ntents .Sheets("Data_Graphs").Range("A4:G10000").ClearCon tents .Sheets("Data_Graphs").Range("J4:M10000").ClearCon tents .Sheets("Data_Graphs").Range("P4:R10000").ClearCon tents 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").E nd (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:D" & 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") |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can't find bug because program justs Stops !!
There are two things you can try
1) comment out the One Error statements while debugging. It make it easier to find problems 2) There is a menu option in VBA to stop on all errors Tools - OPtions - General - Error Trapping Change to Stop On All Errors. 3) In large prgrams you probably want to add break point in th VBA to hepl narrow down where the error is occuring. Using F8 could take a long time Select a line of code in VBA then press F9. Run program. if you get to break point then set another break point futher down in the code. if yo don't get to the break point set the break point earlier in the code. Once yo get to a break point your can step using F8 or continue using F5. "WhytheQ" wrote: 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.Cou nt, 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").Clear Contents .Sheets("Data_MaxMin").Range("A2:AZ10000").ClearCo ntents .Sheets("Data_Graphs").Range("A4:G10000").ClearCon tents .Sheets("Data_Graphs").Range("J4:M10000").ClearCon tents .Sheets("Data_Graphs").Range("P4:R10000").ClearCon tents 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").E nd (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:D" & 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") |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can't find bug because program justs Stops !!
On 21 Aug, 14:26, Joel wrote:
There are two things you can try 1) comment out the One Error statements while debugging. *It make it easier to find problems 2) There is a menu option in VBA to stop on all errors Tools - OPtions - General - Error Trapping Change to Stop On All Errors. 3) In large prgrams you probably want to add break point in th VBA to hepl narrow down where the error is occuring. *Using F8 could take a long time Select a line of code in VBA then press F9. *Run program. *if you get to break point then set another break point futher down in the code. *if yo don't get to the break point set the break point earlier in the code. *Once yo get to a break point your can step using F8 or continue using F5. "WhytheQ" wrote: 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.Cou nt, 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").Clear Contents * * * .Sheets("Data_MaxMin").Range("A2:AZ10000").ClearCo ntents * * * .Sheets("Data_Graphs").Range("A4:G10000").ClearCon tents * * * .Sheets("Data_Graphs").Range("J4:M10000").ClearCon tents * * * .Sheets("Data_Graphs").Range("P4:R10000").ClearCon tents 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").E nd (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:D" & 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 ... read more »- Hide quoted text - - Show quoted text - Thanks for all the help - stepping intot the program is something I've used previously; unfortunately with this problem when I step through this particular program it works fine! What I've ended up doing is adding 20 extra lines of code Debug.print "1", Debug.print "2", Debug.print "3", ....Debug.print "20" throughout the program and next time it stops (it doesn't always!) I'll take a look in the immediate window and make a note of the number .... hopefully narrow down the problem thanks again Jason. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel functions not available then program stops | Excel Discussion (Misc queries) | |||
Program find a 5 minute gap | New Users to Excel | |||
Help! Can't find bug in program | Excel Programming | |||
Excel VBA Macro stops running when another program is activated | Excel Programming | |||
VBA Stops Before competing the program | Excel Programming |