Run Time Error 1004

M

Mike

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
 
J

Jim Thomlinson

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 said:
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
Click to expand...
 
M

Mike

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 said:
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 said:
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
Click to expand...
Click to expand...
 
M

Mike

This is where i get the error
Range("A4:G5,A1:A2").Font.Bold = True


Jim Thomlinson said:
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 said:
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
Click to expand...
Click to expand...
 
C

Chip Pearson

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 said:
This is where i get the error
Range("A4:G5,A1:A2").Font.Bold = True


Jim Thomlinson said:
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 said:
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
Click to expand...
Click to expand...
Click to expand...
 
M

Mike

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 said:
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 said:
This is where i get the error
Range("A4:G5,A1:A2").Font.Bold = True


Jim Thomlinson said:
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


:

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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Run-Time Error 3075 2
Access Table into Excel using VB 2
Run-Time error 1004 in Autofill method of rangle class failed 2
works in 2007 but not in 2010 0
Code does not error but no copy either 4
Macro to generate FileName of the source file 1
Create Detail Sheets from Pivot Table 1
Different Results from the Same Macro 3

Top