Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel hangs
All,
Can anyone tell me why Excel hangs? I THINK I'm doing everything right, but Excel continues to hang and I can't figure out why (Access code to Excel code). Eric Sub GetTechnicianReport(datStart As Date, datEnd As Date) Dim db As DAO.Database, rst As DAO.Recordset, rst2 As DAO.Recordset, xl As Object, qdfTechReport As DAO.QueryDef Dim intCol As Integer, intRow As Integer, fld As Variant, strLetter As String, x As Integer, i As Integer Dim vbCom As Object 'http://www.ozgrid.com/VBA/delete-module.htm Dim y As Integer, strPath As String, rst3 As DAO.Recordset, strRank As String Dim LastRow As Long, LastCol As Long, RngToSort As Object, qdfReports As QueryDef On Error GoTo GetTechnicianReport_Err 'Reload production info to get the most up-to-date data DoCmd.OpenForm "frmProcessing", acNormal DoEvents Set db = CurrentDb DoCmd.SetWarnings False DoCmd.RunSQL "DELETE * from tmpReports" Set qdfReports = db.QueryDefs("qryReports2") qdfReports.Execute DoCmd.SetWarnings True Set qdfReports = Nothing 'Update tmpReports table to the names in the tblEmployee table DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE tmpReports SET tmpReports.UserName =" _ & " 'Susan Skidmore' WHERE (((tmpReports.UserName)='Sue Skidmore'));" DoCmd.RunSQL "UPDATE tmpReports SET tmpReports.UserName =" _ & " 'Kimberly Van Valkenburgh' WHERE (((tmpReports.UserName)='Kim Van Valkenburgh'));" DoCmd.SetWarnings True DoCmd.Close acForm, "frmProcessing" DoEvents 'Generate query & report Set xl = CreateObject("Excel.Application") With xl .Visible = False .Workbooks.Open "\\files-2k1\ENG\QA\Database\Productivity \TechReport.xlt" .Interactive = False .DisplayAlerts = False .ScreenUpdating = False .Sheets("Sheet1").Select 'Generate query Set qdfTechReport = db.QueryDefs("qryTechReport") qdfTechReport.SQL = "SELECT tblEmployee.EmpRptID, TEMP.ProductLineCode, tblEmployee.UserName," _ & " Sum(TEMP.NumOfSets) AS SumOfNumOfSets FROM tblEmployee LEFT JOIN (SELECT UserName," _ & " ProductLineCode, NumOfSets FROM tmpReports WHERE tmpReports.CompleteDate Between #" _ & datStart & "# And #" & datEnd & "#) As TEMP ON tblEmployee.UserName = TEMP.UserName WHERE" _ & " tblEmployee.IsCQATech = True AND tblEmployee.EmpRptID IS NOT NULL GROUP BY tblEmployee.EmpRptID," _ & " TEMP.ProductLineCode, tblEmployee.UserName;" Set qdfTechReport = Nothing .Range("A1").Value = "Completed Production Dates: " & datStart & " and " & datEnd 'Generate Report .Range("A3").Select .Worksheets("Sheet1").Columns("A").ColumnWidth = 15.71 .Worksheets("Sheet1").Columns("C").ColumnWidth = 8.43 Set rst = db.OpenRecordset("qryTechReport_Crosstab") For Each fld In rst.Fields .ActiveCell.Value = fld.Name With .ActiveCell.Borders(9) .LineStyle = 1 .ColorIndex = 0 .Weight = 2 End With With .ActiveCell.Interior .ColorIndex = 15 .Pattern = 1 .PatternColorIndex = -4105 End With .ActiveCell.Offset(0, 1).Select Next fld strLetter = GetColumnLetter(.ActiveCell.Column - 1) .ActiveCell.Offset(1, -(.ActiveCell.Column - 1)).Select rst.MoveFirst Do Until rst.EOF For x = 0 To rst.Fields.Count - 1 .ActiveCell.Offset(0, x).Value = rst.Fields(x).Value Next x rst.MoveNext .ActiveCell.Offset(1, 0).Select Loop 'Create the ranks sheet table .Worksheets("Sheet1").Columns("A").Select .CutCopyMode = 1 .Selection.Copy .Worksheets("Sheet2").Select .Range("A1").PasteSpecial -4104 .ActiveCell.Offset(0, 1).Select 'Order the sheet by where the techs rank Set qdfTechReport = db.QueryDefs("qryRank") qdfTechReport.SQL = "SELECT tblEmployee.EmpRptID, tblEmployee.UserName, Sum(TEMP.NumOfSets) AS" _ & " SumOfNumOfSets FROM tblEmployee LEFT JOIN (SELECT UserName, NumOfSets FROM tmpReports WHERE" _ & " tmpReports.CompleteDate Between #" & datStart & "# And #" & datEnd & "#) AS TEMP ON" _ & " tblEmployee.UserName = TEMP.UserName WHERE tblEmployee.IsCQATech = True And tblEmployee.EmpRptID" _ & " Is Not Null GROUP BY tblEmployee.EmpRptID, tblEmployee.UserName ORDER BY Sum(TEMP.NumOfSets) DESC;" Set qdfTechReport = Nothing Set rst3 = db.OpenRecordset("SELECT EmpRptID FROM qryRank") .Sheets("Sheet1").Select rst3.MoveFirst .Range("B3").Select Do Until rst3.EOF If .ActiveCell.Value = rst3!EmpRptID Then .Worksheets("Sheet1").Columns(GetColumnLetter(.Act iveCell.Column)).Select .CutCopyMode = 1 .Selection.Copy .Worksheets("Sheet2").Select .ActiveCell.PasteSpecial -4104 .ActiveCell.Offset(0, 1).Select .Worksheets("Sheet1").Select .Range("B3").Select rst3.MoveNext Else .ActiveCell.Offset(0, 1).Select End If Loop 'Delete the first sheet .Sheets("Sheet1").Delete .Sheets("Sheet2").Select 'Create the Average Line value .Range("A4").Select If .ActiveCell.Value = "" Then .Rows(.ActiveCell.Row).Delete Do Until .ActiveCell.Value = "" .ActiveCell.Offset(1, 0).Select Loop intRow = .ActiveCell.Row .Range("B" & intRow).Select .ActiveCell.Value = "=Round(Sum(B4:S" & intRow - 1 & ")/18,0)" .ActiveCell.Value = .ActiveCell.Value2 'Make the formula become a static number .ActiveCell.AutoFill Destination:=.Range("B" & intRow & ":" & strLetter & intRow), Type:=0 'Chart Creation intRow = intRow - 1 .ActiveWorkbook.Charts.Add After:=.Worksheets(.Worksheets.Count) .ActiveChart.SetSourceData Source:=.Range("'Sheet2'!$A$3:$" & strLetter & "$" & intRow) .ActiveChart.ChartType = 52 .ActiveChart.HasTitle = True .ActiveChart.ChartTitle.Text = "Individual Parts Chart" & Chr(13) _ & "Completed Production Dates: " & datStart & " and " & datEnd .ActiveChart.SeriesCollection(1).Select 'Set the charts bar color With .ActiveChart For i = .SeriesCollection.Count To 1 Step -1 With .SeriesCollection(i) Select Case .Name Case "0EPS" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 1 .Pattern = 1 End With Case "0LID" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 39 .Pattern = 1 End With Case "0OPS" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 19 .Pattern = 1 End With Case "DELI" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 35 .Pattern = 1 End With Case "PEPS" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 8 .Pattern = 1 End With .Interior.ColorIndex = 8 Case "0PPC" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 7 .Pattern = 1 End With Case "CCUP" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 41 .Pattern = 1 End With Case "0PET" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 4 .Pattern = 1 End With Case "IDIN" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 27 .Pattern = 1 End With Case "EXTF" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 3 .Pattern = 1 End With Case "HAVI" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 43 .Pattern = 1 End With Case "FILM" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 53 .Pattern = 1 End With Case "Gloss" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 10 .Pattern = 1 End With End Select End With Next i End With 'Create the Average line in the chart .ActiveChart.PlotArea.Select .ActiveChart.SeriesCollection.NewSeries y = .ActiveChart.SeriesCollection.Count .ActiveChart.SeriesCollection(y).Values = "=Sheet2!R" & intRow + 1 & "C2:R" & intRow + 1 & "C" & rst.Fields.Count .ActiveChart.SeriesCollection(y).Name = "=""Average""" .ActiveChart.SeriesCollection(y).Select .ActiveChart.SeriesCollection(y).AxisGroup = 1 .ActiveChart.SeriesCollection(y).ChartType = 4 .ActiveChart.SeriesCollection(y).Border.ColorIndex = 1 If .ActiveChart.SeriesCollection.Count = .ActiveChart.Legend.LegendEntries.Count Then .ActiveChart.Legend.LegendEntries(y).Select .Selection.Delete End If .ActiveChart.PlotArea.Select .ActiveChart.Axes(1).Select .ActiveChart.SeriesCollection(1).Select .ActiveChart.SeriesCollection(1).XValues = .Worksheets("Sheet2").Range("B3:S3") 'Generate Weight Factor Report .Sheets("Sheet3").Select .Range("A3").Select .Worksheets("Sheet3").Columns("A").ColumnWidth = 15.71 .Worksheets("Sheet3").Columns("C").ColumnWidth = 8.43 Set rst = db.OpenRecordset("qryTechReport_Crosstab") For Each fld In rst.Fields .ActiveCell.Value = fld.Name With .ActiveCell.Borders(9) .LineStyle = 1 .ColorIndex = 0 .Weight = 2 End With With .ActiveCell.Interior .ColorIndex = 15 .Pattern = 1 .PatternColorIndex = -4105 End With .ActiveCell.Offset(0, 1).Select Next fld strLetter = GetColumnLetter(.ActiveCell.Column - 1) .ActiveCell.Offset(1, -(.ActiveCell.Column - 1)).Select rst.MoveFirst Do Until rst.EOF For x = 0 To rst.Fields.Count - 1 .ActiveCell.Offset(0, x).Value = rst.Fields(x).Value If x 0 Then If Not IsNull(rst.Fields(0).Value) Then Set rst2 = db.OpenRecordset("SELECT WgtFtr FROM tblWgtFtr WHERE" _ & " ProdLine = '" & rst.Fields(0).Value & "'") If .ActiveCell.Offset(0, x).Value * rst2! WgtFtr < 0 Then .ActiveCell.Offset(0, x).Value2 = "=Round(" & .ActiveCell.Offset(0, x).Value * rst2!WgtFtr & ",0)" End If Set rst2 = Nothing End If End If Next x rst.MoveNext .ActiveCell.Offset(1, 0).Select Loop .Range("A4").Select If .ActiveCell.Value = "" Then .Rows(.ActiveCell.Row).Delete Do Until .ActiveCell.Value = "" .ActiveCell.Offset(1, 0).Select Loop intRow = .ActiveCell.Row .Range("B" & intRow).Select .ActiveCell.Value = "=Sum(B4:B" & intRow - 1 & ")" .ActiveCell.AutoFill Destination:=.Range("B" & intRow & ":" & strLetter & intRow), Type:=0 .ActiveCell.Offset(1, 0).Select .ActiveCell.Value = "=Round(Sum(B4:" & strLetter & intRow - 1 & ")/18,0)" .ActiveCell.Value = .ActiveCell.Value2 'Make the formula become a static number .ActiveCell.AutoFill Destination:=.Range("B" & intRow + 1 & ":" & strLetter & intRow + 1), Type:=0 .Range("A4").Select x = 0 Do Until .ActiveCell.Value = "" .ActiveCell.Offset(1, 0).Select x = x + 1 Loop intRow = .ActiveCell.Row - 1 'Create the rank table .Sheets.Add After:=.Sheets(.Sheets.Count) .Sheets("Sheet1").Name = "Sheet4" .Sheets("Sheet3").Select .Range("B3").Select Do Until .ActiveCell.Value = "" .CutCopyMode = 1 .ActiveCell.Copy .Sheets("Sheet4").Select .Range("A1").Select Do If .ActiveCell.Value = "" Then Exit Do Else .ActiveCell.Offset(1, 0).Select End If Loop .ActiveCell.PasteSpecial -4163 .ActiveCell.Offset(0, 1).Select .Sheets("Sheet3").Select .ActiveCell.Offset(x + 1, 0).Copy .Sheets("Sheet4").Select .ActiveCell.PasteSpecial -4163 .ActiveCell.Offset(1, -1).Select .Sheets("Sheet3").Select .ActiveCell.Offset(0, 1).Select Loop With .Worksheets("Sheet4") LastRow = .Cells(.Rows.Count, "A").End(-4162).Row LastCol = .Cells(1, .Columns.Count).End(-4159).Column Set RngToSort = .Range("A1", .Cells(LastRow, LastCol)) End With With RngToSort .Cells.Sort _ Key1:=.Columns(2), Order1:=2, _ header:=2, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=1 End With 'Order the Crosstab table .Sheets.Add After:=.Sheets(.Sheets.Count) .Sheets(.Sheets.Count).Name = "Sheet5" .Sheets("Sheet3").Select .Range("A1").Select .CutCopyMode = 1 .ActiveCell.EntireColumn.Select .ActiveCell.EntireColumn.Copy .Sheets("Sheet5").Select .ActiveCell.Range("A1").Select .ActiveCell.PasteSpecial -4104 .ActiveCell.Offset(0, 1).Select .Sheets("Sheet4").Select intRow = .ActiveCell.Row - 1 .Range("A1").Select strRank = .ActiveCell.Value .Sheets("Sheet3").Select .Range("B3").Select Do If .ActiveCell.Value = strRank Then .CutCopyMode = 1 .ActiveCell.EntireColumn.Select .ActiveCell.EntireColumn.Copy .Sheets("Sheet5").Select .ActiveCell.PasteSpecial -4104 .ActiveCell.Offset(0, 1).Select .Sheets("Sheet4").Select .ActiveCell.Offset(1, 0).Select strRank = .ActiveCell.Value If strRank = "" Then Exit Do .Sheets("Sheet3").Select .Range("B3").Select Else .ActiveCell.Offset(0, 1).Select End If Loop 'Generating Chart .Sheets("Sheet5").Select .Range("A4").Select Do If .ActiveCell.Value = "" Then intRow = .ActiveCell.Row - 1 Exit Do Else .ActiveCell.Offset(1, 0).Select End If Loop .Range("A3").Select Do If .ActiveCell.Value = "" Then strLetter = GetColumnLetter(.ActiveCell.Column - 1) Exit Do Else .ActiveCell.Offset(0, 1).Select End If Loop .ActiveWorkbook.Charts.Add After:=.Worksheets(.Worksheets.Count) .ActiveChart.SetSourceData Source:=.Range("'Sheet5'!$A$3:$" & strLetter & "$" & intRow) .ActiveChart.ChartType = 52 .ActiveChart.HasTitle = True .ActiveChart.ChartTitle.Text = "Weight Factor Chart" & Chr(13) _ & "Completed Production Dates: " & datStart & " and " & datEnd .ActiveChart.Legend.LegendEntries(.ActiveChart.Ser iesCollection.Count).Select '.Selection.Delete '.ActiveChart.SeriesCollection(1).Select '.Selection.Delete 'Set the charts bar color With .ActiveChart For i = .SeriesCollection.Count To 1 Step -1 With .SeriesCollection(i) Select Case .Name Case "0EPS" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 1 .Pattern = 1 End With Case "0LID" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 39 .Pattern = 1 End With Case "0OPS" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 19 .Pattern = 1 End With Case "DELI" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 35 .Pattern = 1 End With Case "PEPS" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 8 .Pattern = 1 End With .Interior.ColorIndex = 8 Case "0PPC" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 7 .Pattern = 1 End With Case "CCUP" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 41 .Pattern = 1 End With Case "0PET" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 4 .Pattern = 1 End With Case "IDIN" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 27 .Pattern = 1 End With Case "EXTF" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 3 .Pattern = 1 End With Case "HAVI" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 43 .Pattern = 1 End With Case "FILM" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 53 .Pattern = 1 End With Case "Gloss" .Select With .Border .Weight = 1 .LineStyle = -4142 End With .Shadow = False .InvertIfNegative = False With .Interior .ColorIndex = 10 .Pattern = 1 End With End Select End With Next i End With 'Create the Average line in the chart .ActiveChart.PlotArea.Select .ActiveChart.SeriesCollection.NewSeries y = .ActiveChart.SeriesCollection.Count .ActiveChart.SeriesCollection(y).Values = "=Sheet5!R" & intRow + 2 & "C2:R" & intRow + 2 & "C" & rst.Fields.Count .ActiveChart.SeriesCollection(y).Name = "=""Average""" .ActiveChart.SeriesCollection(y).Select .ActiveChart.SeriesCollection(y).AxisGroup = 1 .ActiveChart.SeriesCollection(y).ChartType = 4 .ActiveChart.SeriesCollection(y).Border.ColorIndex = 1 If .ActiveChart.SeriesCollection.Count = .ActiveChart.Legend.LegendEntries.Count Then .ActiveChart.Legend.LegendEntries(y).Select .Selection.Delete End If .ActiveChart.PlotArea.Select .ActiveChart.Axes(1).Select .ActiveChart.SeriesCollection(1).XValues = .Worksheets("Sheet4").Range("A1:A18") 'Unlink the chart from the data & remove Module1 from the Excel VBE. 'http://www.ozgrid.com/VBA/delete-module.htm .Charts("Chart1").Select .Run ("DelinkChartFromData") .Charts("Chart2").Select .Run ("DelinkChartFromData") Set vbCom = .VBE.ActiveVBProject.VBComponents vbCom.Remove VBComponent:=vbCom.Item("Module1") Set vbCom = Nothing 'Save the Excel sheet .Charts("Chart1").Select strPath = "G:\" & Month(Date) & "_" & Day(Date) & "_" & Year(Date) & ".xls" If .Version = "12.0" Then .ActiveWorkbook.SaveAs strPath Else .ActiveWorkbook.SaveAs strPath, 43 End If End With Call TechWeightFactor(strPath) xl.Visible = True xl.DisplayAlerts = True xl.ScreenUpdating = True xl.Interactive = True Set xl = Nothing Set rst = Nothing Set rst2 = Nothing Set rst3 = Nothing Set db = Nothing GetTechnicianReport_Err_Exit: Exit Sub GetTechnicianReport_Err: MsgBox Err.Number & " - " & Err.Description Resume GetTechnicianReport_Err_Exit End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel hangs
"EAB1977" wrote in message
... All, Can anyone tell me why Excel hangs? I THINK I'm doing everything right, but Excel continues to hang and I can't figure out why (Access code to Excel code). Eric Here's hoping someone else picks up on your question. You might consider re-posting (ir it were me, I'd probably cross-post this one) to comp.databases.ms-access or microsoft.public.access .... several of the regulars over there are familiar with automating Excel from Access. Have you set any breakpoints to see where Excell is hanging? Does the process complete, never get started, hang somewhere in the middle? At a quick glance, I didn't see anything obvious. One question I did have (but it may be that I'm simply not familiar with the process that you are using) is the [ Set qdfTechReport = Nothing ] at the end of your [ 'Generate query ] section. I recently wrote some automation to create worksheets from Access, and here's a link to the ng posting from Klatuu that got me started: http://groups.google.com/group/micro...bfe2765e53b084 HTH! -- Clif McIrvin (clare reads his mail with moe, nomail feeds the bit bucket :-) |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel Hangs while filtering | Excel Worksheet Functions | |||
Excel hangs... | Excel Programming | |||
Excel hangs up. | Excel Discussion (Misc queries) | |||
Excel hangs | Excel Programming | |||
Excel Hangs | Excel Discussion (Misc queries) |