Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run Time Error 1004
I have a Workbook that runs On Open. Format the sheet Runs the code Adds New
workbook cut and adds inserted copied cells. Close main workbook. The codes runs good as long as I don't have any other workbooks open. Can someone give me some advise to where im going wrong Thanks Mike Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized 'Minimize Excel ColumnNames ColumnWidths ColumnAlign ColumnFormats Dim cnn As ADODB.Connection Dim rs1 As ADODB.Recordset Dim strSQL1 As String, strConn Dim i As Integer Dim ii As Integer Dim iii As Integer ' Dim mydate1 As String ' Dim mydate2 As String ' mydate1 = Sheets(1).Range("H1") 'mydate2 = Sheets(1).Range("H2") i = 6 ii = 1 iii = 2 'Use for Access (jet) strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=C:\Ilsa\Data\" _ & "Ilsa.mdb;Persist Security Info=False" 'Use for jet strSQL1 = "SELECT Inv_Qty.PLU_NUM, Plu.PLU_DESC, Inv_Qty.QTY_ON_HAND," _ & "Plu.LAST_PRICE, [Expr1]-[QTY_ON_HAND] AS Expr2, [QTY_ON_HAND]*[LAST_PRICE] AS Expr3, " _ & "IIf([LAST_PRICE]=10,30,1)*IIf([LAST_PRICE]=5,60,1)*IIf([LAST_PRICE]=1,300,1)*IIf([LAST_PRICE]=2,150,1)*IIf([LAST_PRICE]=3,100,1) AS Expr1," _ & "Now() AS Expr4, Sys_Pram.STORE_NAME" _ & " FROM Sys_Pram, Inv_Qty INNER JOIN Plu ON Inv_Qty.PLU_NUM = Plu.PLU_NUM " _ & "WHERE (((Inv_Qty.QTY_ON_HAND)0) AND ((Plu.DEPT_NUM)=122))" _ & "ORDER BY Plu.LAST_PRICE; " Set cnn = New ADODB.Connection Set rs1 = New ADODB.Recordset cnn.Open strConn rs1.Open strSQL1, cnn, adOpenForwardOnly, adLockReadOnly Do While rs1.EOF = False Sheets("Sheet1").Range("A" & i) = rs1!PLU_NUM Sheets("Sheet1").Range("B" & i) = rs1!PLU_DESC Sheets("Sheet1").Range("C" & i) = rs1!QTY_ON_HAND Sheets("Sheet1").Range("D" & i) = rs1!LAST_PRICE Sheets("Sheet1").Range("E" & i) = rs1!Expr3 Sheets("Sheet1").Range("F" & i) = rs1!Expr2 Sheets("Sheet1").Range("A" & ii) = rs1!STORE_NAME Sheets("Sheet1").Range("A" & iii) = rs1!Expr4 i = i + 1 rs1.MoveNext Loop rs1.Close cnn.Close SubTotal Application.ScreenUpdating = False AddWorkbook End Sub Private Sub ColumnNames() Range("A4:G5,A1:A2").Font.Bold = True Range("A4").Select ActiveCell.FormulaR1C1 = "PLU" Range("A5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("B4").Select ActiveCell.FormulaR1C1 = "PLU" Range("B5").Select ActiveCell.FormulaR1C1 = "DESCRIPTION" Range("C4").Select ActiveCell.FormulaR1C1 = "INV" Range("C5").Select ActiveCell.FormulaR1C1 = "QTY" Range("D4").Select ActiveCell.FormulaR1C1 = "TICKET" Range("D5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("E4").Select ActiveCell.FormulaR1C1 = "TOTAL" Range("E5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("F4").Select ActiveCell.FormulaR1C1 = "ENDING" Range("F5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("G4").Select ActiveCell.FormulaR1C1 = "ACTUAL" Range("G5").Select ActiveCell.FormulaR1C1 = "NUMBER" End Sub Private Sub ColumnAlign() Range("C4:G5").Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Private Sub ColumnWidths() Columns("A:A").ColumnWidth = 12.5 'PLU_NUM Columns("B:B").ColumnWidth = 27 'PLU_DESC Columns("C:C").ColumnWidth = 5 'QTY Columns("D:D").ColumnWidth = 10 'TICKET_RETAIL Columns("E:E").ColumnWidth = 10 'TOTAL_RETAIL Columns("F:F").ColumnWidth = 9 'ENDING_NUM Columns("G:G").ColumnWidth = 9 'ACT_NUM End Sub Private Sub ColumnFormats() Columns("D:E").Select 'TICKET_RETAIL,TOTAL_RETAIL Selection.NumberFormat = "$#,##0.00" Range("A2").Select Selection.NumberFormat = "m/d/yyyy" End Sub Private Sub AddWorkbook() Columns("A:G").Select Selection.Cut Workbooks.Add Selection.Insert Shift:=xlToRight Range("A1").Select Windows("TRO_LOTTERY.xls").Activate Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close 'now close Tro Lottery Workbook End Sub Private Sub SubTotal() Range("D6").Select Selection.SubTotal GroupBy:=4, Function:=xlSum, TotalList:=Array(3, 5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Selection.ClearOutline End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run Time Error 1004
There is too much there to debug without further information. What happens if
there are other books open? What fails? Which procedure is causing the problem? Since you are dealing with ODBC there is no way for us to run this code at our end to debug so you need to do a lot of the ground work... -- HTH... Jim Thomlinson "Mike" wrote: I have a Workbook that runs On Open. Format the sheet Runs the code Adds New workbook cut and adds inserted copied cells. Close main workbook. The codes runs good as long as I don't have any other workbooks open. Can someone give me some advise to where im going wrong Thanks Mike Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized 'Minimize Excel ColumnNames ColumnWidths ColumnAlign ColumnFormats Dim cnn As ADODB.Connection Dim rs1 As ADODB.Recordset Dim strSQL1 As String, strConn Dim i As Integer Dim ii As Integer Dim iii As Integer ' Dim mydate1 As String ' Dim mydate2 As String ' mydate1 = Sheets(1).Range("H1") 'mydate2 = Sheets(1).Range("H2") i = 6 ii = 1 iii = 2 'Use for Access (jet) strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=C:\Ilsa\Data\" _ & "Ilsa.mdb;Persist Security Info=False" 'Use for jet strSQL1 = "SELECT Inv_Qty.PLU_NUM, Plu.PLU_DESC, Inv_Qty.QTY_ON_HAND," _ & "Plu.LAST_PRICE, [Expr1]-[QTY_ON_HAND] AS Expr2, [QTY_ON_HAND]*[LAST_PRICE] AS Expr3, " _ & "IIf([LAST_PRICE]=10,30,1)*IIf([LAST_PRICE]=5,60,1)*IIf([LAST_PRICE]=1,300,1)*IIf([LAST_PRICE]=2,150,1)*IIf([LAST_PRICE]=3,100,1) AS Expr1," _ & "Now() AS Expr4, Sys_Pram.STORE_NAME" _ & " FROM Sys_Pram, Inv_Qty INNER JOIN Plu ON Inv_Qty.PLU_NUM = Plu.PLU_NUM " _ & "WHERE (((Inv_Qty.QTY_ON_HAND)0) AND ((Plu.DEPT_NUM)=122))" _ & "ORDER BY Plu.LAST_PRICE; " Set cnn = New ADODB.Connection Set rs1 = New ADODB.Recordset cnn.Open strConn rs1.Open strSQL1, cnn, adOpenForwardOnly, adLockReadOnly Do While rs1.EOF = False Sheets("Sheet1").Range("A" & i) = rs1!PLU_NUM Sheets("Sheet1").Range("B" & i) = rs1!PLU_DESC Sheets("Sheet1").Range("C" & i) = rs1!QTY_ON_HAND Sheets("Sheet1").Range("D" & i) = rs1!LAST_PRICE Sheets("Sheet1").Range("E" & i) = rs1!Expr3 Sheets("Sheet1").Range("F" & i) = rs1!Expr2 Sheets("Sheet1").Range("A" & ii) = rs1!STORE_NAME Sheets("Sheet1").Range("A" & iii) = rs1!Expr4 i = i + 1 rs1.MoveNext Loop rs1.Close cnn.Close SubTotal Application.ScreenUpdating = False AddWorkbook End Sub Private Sub ColumnNames() Range("A4:G5,A1:A2").Font.Bold = True Range("A4").Select ActiveCell.FormulaR1C1 = "PLU" Range("A5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("B4").Select ActiveCell.FormulaR1C1 = "PLU" Range("B5").Select ActiveCell.FormulaR1C1 = "DESCRIPTION" Range("C4").Select ActiveCell.FormulaR1C1 = "INV" Range("C5").Select ActiveCell.FormulaR1C1 = "QTY" Range("D4").Select ActiveCell.FormulaR1C1 = "TICKET" Range("D5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("E4").Select ActiveCell.FormulaR1C1 = "TOTAL" Range("E5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("F4").Select ActiveCell.FormulaR1C1 = "ENDING" Range("F5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("G4").Select ActiveCell.FormulaR1C1 = "ACTUAL" Range("G5").Select ActiveCell.FormulaR1C1 = "NUMBER" End Sub Private Sub ColumnAlign() Range("C4:G5").Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Private Sub ColumnWidths() Columns("A:A").ColumnWidth = 12.5 'PLU_NUM Columns("B:B").ColumnWidth = 27 'PLU_DESC Columns("C:C").ColumnWidth = 5 'QTY Columns("D:D").ColumnWidth = 10 'TICKET_RETAIL Columns("E:E").ColumnWidth = 10 'TOTAL_RETAIL Columns("F:F").ColumnWidth = 9 'ENDING_NUM Columns("G:G").ColumnWidth = 9 'ACT_NUM End Sub Private Sub ColumnFormats() Columns("D:E").Select 'TICKET_RETAIL,TOTAL_RETAIL Selection.NumberFormat = "$#,##0.00" Range("A2").Select Selection.NumberFormat = "m/d/yyyy" End Sub Private Sub AddWorkbook() Columns("A:G").Select Selection.Cut Workbooks.Add Selection.Insert Shift:=xlToRight Range("A1").Select Windows("TRO_LOTTERY.xls").Activate Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close 'now close Tro Lottery Workbook End Sub Private Sub SubTotal() Range("D6").Select Selection.SubTotal GroupBy:=4, Function:=xlSum, TotalList:=Array(3, 5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Selection.ClearOutline End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run Time Error 1004
Moves to = Run Time Error 1004
All the code outside of the main query. So if I remove the ColumnNames it moves to the ColumnWidths if I remove the ColumnNames & ColumnWidths it moves to ColumnAlign and so on. Thanks Mike "Jim Thomlinson" wrote: There is too much there to debug without further information. What happens if there are other books open? What fails? Which procedure is causing the problem? Since you are dealing with ODBC there is no way for us to run this code at our end to debug so you need to do a lot of the ground work... -- HTH... Jim Thomlinson "Mike" wrote: I have a Workbook that runs On Open. Format the sheet Runs the code Adds New workbook cut and adds inserted copied cells. Close main workbook. The codes runs good as long as I don't have any other workbooks open. Can someone give me some advise to where im going wrong Thanks Mike Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized 'Minimize Excel ColumnNames ColumnWidths ColumnAlign ColumnFormats Dim cnn As ADODB.Connection Dim rs1 As ADODB.Recordset Dim strSQL1 As String, strConn Dim i As Integer Dim ii As Integer Dim iii As Integer ' Dim mydate1 As String ' Dim mydate2 As String ' mydate1 = Sheets(1).Range("H1") 'mydate2 = Sheets(1).Range("H2") i = 6 ii = 1 iii = 2 'Use for Access (jet) strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=C:\Ilsa\Data\" _ & "Ilsa.mdb;Persist Security Info=False" 'Use for jet strSQL1 = "SELECT Inv_Qty.PLU_NUM, Plu.PLU_DESC, Inv_Qty.QTY_ON_HAND," _ & "Plu.LAST_PRICE, [Expr1]-[QTY_ON_HAND] AS Expr2, [QTY_ON_HAND]*[LAST_PRICE] AS Expr3, " _ & "IIf([LAST_PRICE]=10,30,1)*IIf([LAST_PRICE]=5,60,1)*IIf([LAST_PRICE]=1,300,1)*IIf([LAST_PRICE]=2,150,1)*IIf([LAST_PRICE]=3,100,1) AS Expr1," _ & "Now() AS Expr4, Sys_Pram.STORE_NAME" _ & " FROM Sys_Pram, Inv_Qty INNER JOIN Plu ON Inv_Qty.PLU_NUM = Plu.PLU_NUM " _ & "WHERE (((Inv_Qty.QTY_ON_HAND)0) AND ((Plu.DEPT_NUM)=122))" _ & "ORDER BY Plu.LAST_PRICE; " Set cnn = New ADODB.Connection Set rs1 = New ADODB.Recordset cnn.Open strConn rs1.Open strSQL1, cnn, adOpenForwardOnly, adLockReadOnly Do While rs1.EOF = False Sheets("Sheet1").Range("A" & i) = rs1!PLU_NUM Sheets("Sheet1").Range("B" & i) = rs1!PLU_DESC Sheets("Sheet1").Range("C" & i) = rs1!QTY_ON_HAND Sheets("Sheet1").Range("D" & i) = rs1!LAST_PRICE Sheets("Sheet1").Range("E" & i) = rs1!Expr3 Sheets("Sheet1").Range("F" & i) = rs1!Expr2 Sheets("Sheet1").Range("A" & ii) = rs1!STORE_NAME Sheets("Sheet1").Range("A" & iii) = rs1!Expr4 i = i + 1 rs1.MoveNext Loop rs1.Close cnn.Close SubTotal Application.ScreenUpdating = False AddWorkbook End Sub Private Sub ColumnNames() Range("A4:G5,A1:A2").Font.Bold = True Range("A4").Select ActiveCell.FormulaR1C1 = "PLU" Range("A5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("B4").Select ActiveCell.FormulaR1C1 = "PLU" Range("B5").Select ActiveCell.FormulaR1C1 = "DESCRIPTION" Range("C4").Select ActiveCell.FormulaR1C1 = "INV" Range("C5").Select ActiveCell.FormulaR1C1 = "QTY" Range("D4").Select ActiveCell.FormulaR1C1 = "TICKET" Range("D5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("E4").Select ActiveCell.FormulaR1C1 = "TOTAL" Range("E5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("F4").Select ActiveCell.FormulaR1C1 = "ENDING" Range("F5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("G4").Select ActiveCell.FormulaR1C1 = "ACTUAL" Range("G5").Select ActiveCell.FormulaR1C1 = "NUMBER" End Sub Private Sub ColumnAlign() Range("C4:G5").Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Private Sub ColumnWidths() Columns("A:A").ColumnWidth = 12.5 'PLU_NUM Columns("B:B").ColumnWidth = 27 'PLU_DESC Columns("C:C").ColumnWidth = 5 'QTY Columns("D:D").ColumnWidth = 10 'TICKET_RETAIL Columns("E:E").ColumnWidth = 10 'TOTAL_RETAIL Columns("F:F").ColumnWidth = 9 'ENDING_NUM Columns("G:G").ColumnWidth = 9 'ACT_NUM End Sub Private Sub ColumnFormats() Columns("D:E").Select 'TICKET_RETAIL,TOTAL_RETAIL Selection.NumberFormat = "$#,##0.00" Range("A2").Select Selection.NumberFormat = "m/d/yyyy" End Sub Private Sub AddWorkbook() Columns("A:G").Select Selection.Cut Workbooks.Add Selection.Insert Shift:=xlToRight Range("A1").Select Windows("TRO_LOTTERY.xls").Activate Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close 'now close Tro Lottery Workbook End Sub Private Sub SubTotal() Range("D6").Select Selection.SubTotal GroupBy:=4, Function:=xlSum, TotalList:=Array(3, 5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Selection.ClearOutline End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run Time Error 1004
This is where i get the error
Range("A4:G5,A1:A2").Font.Bold = True "Jim Thomlinson" wrote: There is too much there to debug without further information. What happens if there are other books open? What fails? Which procedure is causing the problem? Since you are dealing with ODBC there is no way for us to run this code at our end to debug so you need to do a lot of the ground work... -- HTH... Jim Thomlinson "Mike" wrote: I have a Workbook that runs On Open. Format the sheet Runs the code Adds New workbook cut and adds inserted copied cells. Close main workbook. The codes runs good as long as I don't have any other workbooks open. Can someone give me some advise to where im going wrong Thanks Mike Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized 'Minimize Excel ColumnNames ColumnWidths ColumnAlign ColumnFormats Dim cnn As ADODB.Connection Dim rs1 As ADODB.Recordset Dim strSQL1 As String, strConn Dim i As Integer Dim ii As Integer Dim iii As Integer ' Dim mydate1 As String ' Dim mydate2 As String ' mydate1 = Sheets(1).Range("H1") 'mydate2 = Sheets(1).Range("H2") i = 6 ii = 1 iii = 2 'Use for Access (jet) strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=C:\Ilsa\Data\" _ & "Ilsa.mdb;Persist Security Info=False" 'Use for jet strSQL1 = "SELECT Inv_Qty.PLU_NUM, Plu.PLU_DESC, Inv_Qty.QTY_ON_HAND," _ & "Plu.LAST_PRICE, [Expr1]-[QTY_ON_HAND] AS Expr2, [QTY_ON_HAND]*[LAST_PRICE] AS Expr3, " _ & "IIf([LAST_PRICE]=10,30,1)*IIf([LAST_PRICE]=5,60,1)*IIf([LAST_PRICE]=1,300,1)*IIf([LAST_PRICE]=2,150,1)*IIf([LAST_PRICE]=3,100,1) AS Expr1," _ & "Now() AS Expr4, Sys_Pram.STORE_NAME" _ & " FROM Sys_Pram, Inv_Qty INNER JOIN Plu ON Inv_Qty.PLU_NUM = Plu.PLU_NUM " _ & "WHERE (((Inv_Qty.QTY_ON_HAND)0) AND ((Plu.DEPT_NUM)=122))" _ & "ORDER BY Plu.LAST_PRICE; " Set cnn = New ADODB.Connection Set rs1 = New ADODB.Recordset cnn.Open strConn rs1.Open strSQL1, cnn, adOpenForwardOnly, adLockReadOnly Do While rs1.EOF = False Sheets("Sheet1").Range("A" & i) = rs1!PLU_NUM Sheets("Sheet1").Range("B" & i) = rs1!PLU_DESC Sheets("Sheet1").Range("C" & i) = rs1!QTY_ON_HAND Sheets("Sheet1").Range("D" & i) = rs1!LAST_PRICE Sheets("Sheet1").Range("E" & i) = rs1!Expr3 Sheets("Sheet1").Range("F" & i) = rs1!Expr2 Sheets("Sheet1").Range("A" & ii) = rs1!STORE_NAME Sheets("Sheet1").Range("A" & iii) = rs1!Expr4 i = i + 1 rs1.MoveNext Loop rs1.Close cnn.Close SubTotal Application.ScreenUpdating = False AddWorkbook End Sub Private Sub ColumnNames() Range("A4:G5,A1:A2").Font.Bold = True Range("A4").Select ActiveCell.FormulaR1C1 = "PLU" Range("A5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("B4").Select ActiveCell.FormulaR1C1 = "PLU" Range("B5").Select ActiveCell.FormulaR1C1 = "DESCRIPTION" Range("C4").Select ActiveCell.FormulaR1C1 = "INV" Range("C5").Select ActiveCell.FormulaR1C1 = "QTY" Range("D4").Select ActiveCell.FormulaR1C1 = "TICKET" Range("D5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("E4").Select ActiveCell.FormulaR1C1 = "TOTAL" Range("E5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("F4").Select ActiveCell.FormulaR1C1 = "ENDING" Range("F5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("G4").Select ActiveCell.FormulaR1C1 = "ACTUAL" Range("G5").Select ActiveCell.FormulaR1C1 = "NUMBER" End Sub Private Sub ColumnAlign() Range("C4:G5").Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Private Sub ColumnWidths() Columns("A:A").ColumnWidth = 12.5 'PLU_NUM Columns("B:B").ColumnWidth = 27 'PLU_DESC Columns("C:C").ColumnWidth = 5 'QTY Columns("D:D").ColumnWidth = 10 'TICKET_RETAIL Columns("E:E").ColumnWidth = 10 'TOTAL_RETAIL Columns("F:F").ColumnWidth = 9 'ENDING_NUM Columns("G:G").ColumnWidth = 9 'ACT_NUM End Sub Private Sub ColumnFormats() Columns("D:E").Select 'TICKET_RETAIL,TOTAL_RETAIL Selection.NumberFormat = "$#,##0.00" Range("A2").Select Selection.NumberFormat = "m/d/yyyy" End Sub Private Sub AddWorkbook() Columns("A:G").Select Selection.Cut Workbooks.Add Selection.Insert Shift:=xlToRight Range("A1").Select Windows("TRO_LOTTERY.xls").Activate Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close 'now close Tro Lottery Workbook End Sub Private Sub SubTotal() Range("D6").Select Selection.SubTotal GroupBy:=4, Function:=xlSum, TotalList:=Array(3, 5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Selection.ClearOutline End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run Time Error 1004
Is the worksheet protected?
-- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "Mike" wrote in message ... This is where i get the error Range("A4:G5,A1:A2").Font.Bold = True "Jim Thomlinson" wrote: There is too much there to debug without further information. What happens if there are other books open? What fails? Which procedure is causing the problem? Since you are dealing with ODBC there is no way for us to run this code at our end to debug so you need to do a lot of the ground work... -- HTH... Jim Thomlinson "Mike" wrote: I have a Workbook that runs On Open. Format the sheet Runs the code Adds New workbook cut and adds inserted copied cells. Close main workbook. The codes runs good as long as I don't have any other workbooks open. Can someone give me some advise to where im going wrong Thanks Mike Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized 'Minimize Excel ColumnNames ColumnWidths ColumnAlign ColumnFormats Dim cnn As ADODB.Connection Dim rs1 As ADODB.Recordset Dim strSQL1 As String, strConn Dim i As Integer Dim ii As Integer Dim iii As Integer ' Dim mydate1 As String ' Dim mydate2 As String ' mydate1 = Sheets(1).Range("H1") 'mydate2 = Sheets(1).Range("H2") i = 6 ii = 1 iii = 2 'Use for Access (jet) strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=C:\Ilsa\Data\" _ & "Ilsa.mdb;Persist Security Info=False" 'Use for jet strSQL1 = "SELECT Inv_Qty.PLU_NUM, Plu.PLU_DESC, Inv_Qty.QTY_ON_HAND," _ & "Plu.LAST_PRICE, [Expr1]-[QTY_ON_HAND] AS Expr2, [QTY_ON_HAND]*[LAST_PRICE] AS Expr3, " _ & "IIf([LAST_PRICE]=10,30,1)*IIf([LAST_PRICE]=5,60,1)*IIf([LAST_PRICE]=1,300,1)*IIf([LAST_PRICE]=2,150,1)*IIf([LAST_PRICE]=3,100,1) AS Expr1," _ & "Now() AS Expr4, Sys_Pram.STORE_NAME" _ & " FROM Sys_Pram, Inv_Qty INNER JOIN Plu ON Inv_Qty.PLU_NUM = Plu.PLU_NUM " _ & "WHERE (((Inv_Qty.QTY_ON_HAND)0) AND ((Plu.DEPT_NUM)=122))" _ & "ORDER BY Plu.LAST_PRICE; " Set cnn = New ADODB.Connection Set rs1 = New ADODB.Recordset cnn.Open strConn rs1.Open strSQL1, cnn, adOpenForwardOnly, adLockReadOnly Do While rs1.EOF = False Sheets("Sheet1").Range("A" & i) = rs1!PLU_NUM Sheets("Sheet1").Range("B" & i) = rs1!PLU_DESC Sheets("Sheet1").Range("C" & i) = rs1!QTY_ON_HAND Sheets("Sheet1").Range("D" & i) = rs1!LAST_PRICE Sheets("Sheet1").Range("E" & i) = rs1!Expr3 Sheets("Sheet1").Range("F" & i) = rs1!Expr2 Sheets("Sheet1").Range("A" & ii) = rs1!STORE_NAME Sheets("Sheet1").Range("A" & iii) = rs1!Expr4 i = i + 1 rs1.MoveNext Loop rs1.Close cnn.Close SubTotal Application.ScreenUpdating = False AddWorkbook End Sub Private Sub ColumnNames() Range("A4:G5,A1:A2").Font.Bold = True Range("A4").Select ActiveCell.FormulaR1C1 = "PLU" Range("A5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("B4").Select ActiveCell.FormulaR1C1 = "PLU" Range("B5").Select ActiveCell.FormulaR1C1 = "DESCRIPTION" Range("C4").Select ActiveCell.FormulaR1C1 = "INV" Range("C5").Select ActiveCell.FormulaR1C1 = "QTY" Range("D4").Select ActiveCell.FormulaR1C1 = "TICKET" Range("D5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("E4").Select ActiveCell.FormulaR1C1 = "TOTAL" Range("E5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("F4").Select ActiveCell.FormulaR1C1 = "ENDING" Range("F5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("G4").Select ActiveCell.FormulaR1C1 = "ACTUAL" Range("G5").Select ActiveCell.FormulaR1C1 = "NUMBER" End Sub Private Sub ColumnAlign() Range("C4:G5").Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Private Sub ColumnWidths() Columns("A:A").ColumnWidth = 12.5 'PLU_NUM Columns("B:B").ColumnWidth = 27 'PLU_DESC Columns("C:C").ColumnWidth = 5 'QTY Columns("D:D").ColumnWidth = 10 'TICKET_RETAIL Columns("E:E").ColumnWidth = 10 'TOTAL_RETAIL Columns("F:F").ColumnWidth = 9 'ENDING_NUM Columns("G:G").ColumnWidth = 9 'ACT_NUM End Sub Private Sub ColumnFormats() Columns("D:E").Select 'TICKET_RETAIL,TOTAL_RETAIL Selection.NumberFormat = "$#,##0.00" Range("A2").Select Selection.NumberFormat = "m/d/yyyy" End Sub Private Sub AddWorkbook() Columns("A:G").Select Selection.Cut Workbooks.Add Selection.Insert Shift:=xlToRight Range("A1").Select Windows("TRO_LOTTERY.xls").Activate Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close 'now close Tro Lottery Workbook End Sub Private Sub SubTotal() Range("D6").Select Selection.SubTotal GroupBy:=4, Function:=xlSum, TotalList:=Array(3, 5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Selection.ClearOutline End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Run Time Error 1004
This workbook is not protected. Some other workbooks that I may have open are.
Its like the cut and paste wants to cut the workbook that is open and paste into a workbook that is already open and not the worbook that I just opened. You see the code will run without error if there is no other excel files open. "Chip Pearson" wrote: Is the worksheet protected? -- Cordially, Chip Pearson Microsoft MVP - Excel Pearson Software Consulting, LLC www.cpearson.com (email address is on the web site) "Mike" wrote in message ... This is where i get the error Range("A4:G5,A1:A2").Font.Bold = True "Jim Thomlinson" wrote: There is too much there to debug without further information. What happens if there are other books open? What fails? Which procedure is causing the problem? Since you are dealing with ODBC there is no way for us to run this code at our end to debug so you need to do a lot of the ground work... -- HTH... Jim Thomlinson "Mike" wrote: I have a Workbook that runs On Open. Format the sheet Runs the code Adds New workbook cut and adds inserted copied cells. Close main workbook. The codes runs good as long as I don't have any other workbooks open. Can someone give me some advise to where im going wrong Thanks Mike Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized 'Minimize Excel ColumnNames ColumnWidths ColumnAlign ColumnFormats Dim cnn As ADODB.Connection Dim rs1 As ADODB.Recordset Dim strSQL1 As String, strConn Dim i As Integer Dim ii As Integer Dim iii As Integer ' Dim mydate1 As String ' Dim mydate2 As String ' mydate1 = Sheets(1).Range("H1") 'mydate2 = Sheets(1).Range("H2") i = 6 ii = 1 iii = 2 'Use for Access (jet) strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=C:\Ilsa\Data\" _ & "Ilsa.mdb;Persist Security Info=False" 'Use for jet strSQL1 = "SELECT Inv_Qty.PLU_NUM, Plu.PLU_DESC, Inv_Qty.QTY_ON_HAND," _ & "Plu.LAST_PRICE, [Expr1]-[QTY_ON_HAND] AS Expr2, [QTY_ON_HAND]*[LAST_PRICE] AS Expr3, " _ & "IIf([LAST_PRICE]=10,30,1)*IIf([LAST_PRICE]=5,60,1)*IIf([LAST_PRICE]=1,300,1)*IIf([LAST_PRICE]=2,150,1)*IIf([LAST_PRICE]=3,100,1) AS Expr1," _ & "Now() AS Expr4, Sys_Pram.STORE_NAME" _ & " FROM Sys_Pram, Inv_Qty INNER JOIN Plu ON Inv_Qty.PLU_NUM = Plu.PLU_NUM " _ & "WHERE (((Inv_Qty.QTY_ON_HAND)0) AND ((Plu.DEPT_NUM)=122))" _ & "ORDER BY Plu.LAST_PRICE; " Set cnn = New ADODB.Connection Set rs1 = New ADODB.Recordset cnn.Open strConn rs1.Open strSQL1, cnn, adOpenForwardOnly, adLockReadOnly Do While rs1.EOF = False Sheets("Sheet1").Range("A" & i) = rs1!PLU_NUM Sheets("Sheet1").Range("B" & i) = rs1!PLU_DESC Sheets("Sheet1").Range("C" & i) = rs1!QTY_ON_HAND Sheets("Sheet1").Range("D" & i) = rs1!LAST_PRICE Sheets("Sheet1").Range("E" & i) = rs1!Expr3 Sheets("Sheet1").Range("F" & i) = rs1!Expr2 Sheets("Sheet1").Range("A" & ii) = rs1!STORE_NAME Sheets("Sheet1").Range("A" & iii) = rs1!Expr4 i = i + 1 rs1.MoveNext Loop rs1.Close cnn.Close SubTotal Application.ScreenUpdating = False AddWorkbook End Sub Private Sub ColumnNames() Range("A4:G5,A1:A2").Font.Bold = True Range("A4").Select ActiveCell.FormulaR1C1 = "PLU" Range("A5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("B4").Select ActiveCell.FormulaR1C1 = "PLU" Range("B5").Select ActiveCell.FormulaR1C1 = "DESCRIPTION" Range("C4").Select ActiveCell.FormulaR1C1 = "INV" Range("C5").Select ActiveCell.FormulaR1C1 = "QTY" Range("D4").Select ActiveCell.FormulaR1C1 = "TICKET" Range("D5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("E4").Select ActiveCell.FormulaR1C1 = "TOTAL" Range("E5").Select ActiveCell.FormulaR1C1 = "RETAIL" Range("F4").Select ActiveCell.FormulaR1C1 = "ENDING" Range("F5").Select ActiveCell.FormulaR1C1 = "NUMBER" Range("G4").Select ActiveCell.FormulaR1C1 = "ACTUAL" Range("G5").Select ActiveCell.FormulaR1C1 = "NUMBER" End Sub Private Sub ColumnAlign() Range("C4:G5").Select With Selection .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub Private Sub ColumnWidths() Columns("A:A").ColumnWidth = 12.5 'PLU_NUM Columns("B:B").ColumnWidth = 27 'PLU_DESC Columns("C:C").ColumnWidth = 5 'QTY Columns("D:D").ColumnWidth = 10 'TICKET_RETAIL Columns("E:E").ColumnWidth = 10 'TOTAL_RETAIL Columns("F:F").ColumnWidth = 9 'ENDING_NUM Columns("G:G").ColumnWidth = 9 'ACT_NUM End Sub Private Sub ColumnFormats() Columns("D:E").Select 'TICKET_RETAIL,TOTAL_RETAIL Selection.NumberFormat = "$#,##0.00" Range("A2").Select Selection.NumberFormat = "m/d/yyyy" End Sub Private Sub AddWorkbook() Columns("A:G").Select Selection.Cut Workbooks.Add Selection.Insert Shift:=xlToRight Range("A1").Select Windows("TRO_LOTTERY.xls").Activate Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close 'now close Tro Lottery Workbook End Sub Private Sub SubTotal() Range("D6").Select Selection.SubTotal GroupBy:=4, Function:=xlSum, TotalList:=Array(3, 5), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Selection.ClearOutline End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Run Time Error 1004: Application or Object Defined Error | Excel Programming | |||
Run Time 1004 Error: Application or Object Difine Error | Excel Programming | |||
Run-time error 1004 - General ODBC Error | Excel Programming | |||
run-time error '1004': Application-defined or object-deifined error | Excel Programming | |||
Run time error '1004': Generaol ODBC error | Excel Programming |