Excel 2003 macro won't run in Excel 2007

P

pickytweety

I recently switched from Excel 2003 to 2007. A macro I had would vlookup
information for a particular store into a template sheet, copy that sheet,
paste it as values, and move to the next store. This macro isn't working
anymore. I get an error 440 and it closes Excel for me. So I tried going
showing both Excel and Visual Basic on screen to F8 (step) through the VBA
code. It used to show me what was happening in Excel as I stepped through
each line of code. For example I would F8 on a line of code like
'Sheets("list").Select' and Excel would flip over to the "list" worksheet
before my eyes. So I have two questions.....one, how do I get Excel to
perform as I step through each line of VBA code so I can see what's happening
and two, any ideas on why I'm getting an error 440?
Here's the code:

Sub RunReport()
'
' RunReport Macro
' Macro recorded 9/7/2005 by CR28012

Dim strBottom As Integer
Dim strLocation As String

'clear the old "YTD dir bonus summary" page
Sheets("YTD dir bonus summary").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
Rows("9:9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'clear the old "YTD asst bonus summary" page
Sheets("YTD asst bonus summary").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
Rows("9:9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'Select the list of stores (range) on "scroll list" sheet
Sheets("scroll list").Activate
Range("a1").Select
Selection.End(xlDown).Select
strBottom = ActiveCell.Row
Range(Range("A1").Address & ":" & "A" & strBottom).Select

'Loop through each location
For Each cell In Selection
Sheets("scroll list").Select
Range(cell.Address).Copy
Sheets("Template").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Calculate
strLocation = Range("B1").Value
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'Create new sheet for location and name it
ActiveSheet.Copy Before:=Sheets("Template")
ActiveSheet.Name = Trim(strLocation)

'Select cells and replace formulas with values
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Cells.Replace What:="0", Replacement:="0", LookAt:=xlPart,
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select


'fill in the next line of the "YTD dir bonus summary" sheet
Sheets("YTD dir bonus summary").Select

ActiveSheet.Calculate
Rows("5:5").Select
Selection.Copy
Range("a" & Rows.Count).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Rows.Ungroup
'fill in the next line of the "YTD asst bonus summary" sheet
Sheets("YTD asst bonus summary").Select

ActiveSheet.Calculate
Rows("5:5").Select
Selection.Copy
Range("a" & Rows.Count).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Rows.Ungroup


Next

Sheets("YTD dir bonus summary").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("A1").Select

Sheets("YTD asst bonus summary").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("A1").Select

'Hide working sheets
Sheets("Template").Visible = False
Sheets("Instructions").Visible = False
Sheets("str list").Visible = False
Sheets("SOSP03").Visible = False
Sheets("SOSP03 YTD").Visible = False
Sheets("ident sales").Visible = False
Sheets("ident sales YTD").Visible = False
Sheets("not ident history").Visible = False
Sheets("SOSP04-Inv").Visible = False
Sheets("SOSP05-labor actuals").Visible = False
Sheets("SOSP05 YTD-labor actuals").Visible = False
Sheets("Gordy's labor bud").Visible = False
Sheets("Gordy's labor bud YTD").Visible = False
Sheets("Poulsen's P&G focus QTR").Visible = False
Sheets("Gary's bonus").Visible = False
Sheets("Hal's out of stock").Visible = False
Sheets("Cust 1st fr Mys Shop").Visible = False
Sheets("Sales Brackets").Visible = False
Sheets("Mys Shop Goals").Visible = False
Sheets("Key Retailing").Visible = False
Sheets("Rod's Turnover").Visible = False
Sheets("Mark's Safety").Visible = False
Sheets("Bill's Loyalty").Visible = False
Sheets("Points Summary").Visible = False
Sheets("scroll list").Visible = False

End Sub
 
M

meh2030

I recently switched from Excel 2003 to 2007. A macro I had would vlookup
information for a particular store into a template sheet, copy that sheet,
paste it as values, and move to the next store. This macro isn't working
anymore. I get an error 440 and it closes Excel for me. So I tried going
showing both Excel and Visual Basic on screen to F8 (step) through the VBA
code. It used to show me what was happening in Excel as I stepped through
each line of code. For example I would F8 on a line of code like
'Sheets("list").Select' and Excel would flip over to the "list" worksheet
before my eyes. So I have two questions.....one, how do I get Excel to
perform as I step through each line of VBA code so I can see what's happening
and two, any ideas on why I'm getting an error 440?
Here's the code:

Sub RunReport()
'
' RunReport Macro
' Macro recorded 9/7/2005 by CR28012

Dim strBottom As Integer
Dim strLocation As String

'clear the old "YTD dir bonus summary" page
Sheets("YTD dir bonus summary").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
Rows("9:9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'clear the old "YTD asst bonus summary" page
Sheets("YTD asst bonus summary").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
Rows("9:9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'Select the list of stores (range) on "scroll list" sheet
Sheets("scroll list").Activate
Range("a1").Select
Selection.End(xlDown).Select
strBottom = ActiveCell.Row
Range(Range("A1").Address & ":" & "A" & strBottom).Select

'Loop through each location
For Each cell In Selection
Sheets("scroll list").Select
Range(cell.Address).Copy
Sheets("Template").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Calculate
strLocation = Range("B1").Value
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'Create new sheet for location and name it
ActiveSheet.Copy Before:=Sheets("Template")
ActiveSheet.Name = Trim(strLocation)

'Select cells and replace formulas with values
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Cells.Replace What:="0", Replacement:="0", LookAt:=xlPart,
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select

'fill in the next line of the "YTD dir bonus summary" sheet
Sheets("YTD dir bonus summary").Select

ActiveSheet.Calculate
Rows("5:5").Select
Selection.Copy
Range("a" & Rows.Count).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Rows.Ungroup
'fill in the next line of the "YTD asst bonus summary" sheet
Sheets("YTD asst bonus summary").Select

ActiveSheet.Calculate
Rows("5:5").Select
Selection.Copy
Range("a" & Rows.Count).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Rows.Ungroup

Next

Sheets("YTD dir bonus summary").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("A1").Select

Sheets("YTD asst bonus summary").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("A1").Select

'Hide working sheets
Sheets("Template").Visible = False
Sheets("Instructions").Visible = False
Sheets("str list").Visible = False
Sheets("SOSP03").Visible = False
Sheets("SOSP03 YTD").Visible = False
Sheets("ident sales").Visible = False
Sheets("ident sales YTD").Visible = False
Sheets("not ident history").Visible = False
Sheets("SOSP04-Inv").Visible = False
Sheets("SOSP05-labor actuals").Visible = False
Sheets("SOSP05 YTD-labor actuals").Visible = False
Sheets("Gordy's labor bud").Visible = False
Sheets("Gordy's labor bud YTD").Visible = False
Sheets("Poulsen's P&G focus QTR").Visible = False
Sheets("Gary's bonus").Visible = False
Sheets("Hal's out of stock").Visible = False
Sheets("Cust 1st fr Mys Shop").Visible = False
Sheets("Sales Brackets").Visible = False
Sheets("Mys Shop Goals").Visible = False
Sheets("Key Retailing").Visible = False
Sheets("Rod's Turnover").Visible = False
Sheets("Mark's Safety").Visible = False
Sheets("Bill's Loyalty").Visible = False
Sheets("Points Summary").Visible = False
Sheets("scroll list").Visible = False

End Sub
Click to expand...

PTweenty,

You need to be more specific in your problem description. Stepping
through the macro with F8 should work just fine in Excel 2007. What
line of code does error 440 occur on? Your code has a lot of
unnecessary items in it. I haven't tested any of what is below, but
it should greatly simplify what you have. Repost a more descriptive
explanation of where you are encountering your error. Your post is
quite vague.

Best,

Matt Herbert

Sub RunReport()

Dim strLocation As String
Dim rngLoop As Range
Dim rngCell As Range
Dim wksTemp As Worksheet
Dim wksScroll As Worksheet
Dim wksNew As Worksheet
Dim wksDirBonus As Worksheet
Dim wksAstBonus As Worksheet
Dim rngfill As Range

'set the Template and Scroll List worksheets as objects
Set wksTemp = Sheets("Template")
Set wksScroll = Sheets("Scroll List")
Set wksDirBonus = Sheets("YTD dir bonus summary")
Set wksAstBonus = Sheets("YTD asst bonus summary")

'clear the old "YTD dir bonus summary" page
wksDirBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

'clear the old "YTD asst bonus summary" page
wksAstBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

'Select the list of stores (range) on "scroll list" sheet
With wksScroll
Set rngLoop = Range("a1", .Range("a1").End(xlDown))
End With

'show outline levels on wksTemp
wksTemp.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'Loop through each cell in rngLoop
For Each rngCell In rngLoop
With wksTemp
.Range("B1").Value = rngCell
.Calculate
strLocation = .Range("B1").Value
End With

'Create new sheet for strLocation and name it
wksTemp.Copy Before:=wksTemp
Set wksNew = ActiveSheet

With wksNew
.Name = Trim(strLocation)

'Select cells and replace formulas with values
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With

'fill in the next line of wksDirBonus
CopyToNext wksDirBonus

'fill in the next line of wksAstBonus
CopyToNext wksAstBonus
Next

wksDirBonus.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
wksAstBonus.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'What do your non-working sheets comprise? I'm sure there is a
' better way of hiding the working sheets.

'Hide working sheets
Sheets("Template").Visible = False
Sheets("Instructions").Visible = False
Sheets("str list").Visible = False
Sheets("SOSP03").Visible = False
Sheets("SOSP03 YTD").Visible = False
Sheets("ident sales").Visible = False
Sheets("ident sales YTD").Visible = False
Sheets("not ident history").Visible = False
Sheets("SOSP04-Inv").Visible = False
Sheets("SOSP05-labor actuals").Visible = False
Sheets("SOSP05 YTD-labor actuals").Visible = False
Sheets("Gordy's labor bud").Visible = False
Sheets("Gordy's labor bud YTD").Visible = False
Sheets("Poulsen's P&G focus QTR").Visible = False
Sheets("Gary's bonus").Visible = False
Sheets("Hal's out of stock").Visible = False
Sheets("Cust 1st fr Mys Shop").Visible = False
Sheets("Sales Brackets").Visible = False
Sheets("Mys Shop Goals").Visible = False
Sheets("Key Retailing").Visible = False
Sheets("Rod's Turnover").Visible = False
Sheets("Mark's Safety").Visible = False
Sheets("Bill's Loyalty").Visible = False
Sheets("Points Summary").Visible = False
Sheets("scroll list").Visible = False

End Sub

Sub CopyToNext(wks As Worksheet)

Dim rngfill As Range

With wks
.Calculate
Set rngfill = Nothing
Set rngfill = Range("A" & Rows.Count).End(xlUp)
Set rngfill = rngfill.Offset(1, 0)

Rows("5:5").Copy
rngfill.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

rngfill.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

'not sure what the line below is for

'Selection.Rows.Ungroup
End With

End Sub
 
B

Bernie Deitrick

When you are working with ranges, you should be more specific with your
ranges' parent. For example, the

Range("a9").End(xlDown)

from this line

wksDirBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

will be based on the active sheet, not wksDirBonus. The code should be, at
the very least

With wksDirBonus
.Range("a9", .Range("a9").End(xlDown)).ClearContents
End With

Bernie

I recently switched from Excel 2003 to 2007. A macro I had would vlookup
information for a particular store into a template sheet, copy that sheet,
paste it as values, and move to the next store. This macro isn't working
anymore. I get an error 440 and it closes Excel for me. So I tried going
showing both Excel and Visual Basic on screen to F8 (step) through the VBA
code. It used to show me what was happening in Excel as I stepped through
each line of code. For example I would F8 on a line of code like
'Sheets("list").Select' and Excel would flip over to the "list" worksheet
before my eyes. So I have two questions.....one, how do I get Excel to
perform as I step through each line of VBA code so I can see what's
happening
and two, any ideas on why I'm getting an error 440?
Here's the code:

Sub RunReport()
'
' RunReport Macro
' Macro recorded 9/7/2005 by CR28012

Dim strBottom As Integer
Dim strLocation As String

'clear the old "YTD dir bonus summary" page
Sheets("YTD dir bonus summary").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
Rows("9:9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'clear the old "YTD asst bonus summary" page
Sheets("YTD asst bonus summary").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
Rows("9:9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'Select the list of stores (range) on "scroll list" sheet
Sheets("scroll list").Activate
Range("a1").Select
Selection.End(xlDown).Select
strBottom = ActiveCell.Row
Range(Range("A1").Address & ":" & "A" & strBottom).Select

'Loop through each location
For Each cell In Selection
Sheets("scroll list").Select
Range(cell.Address).Copy
Sheets("Template").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveSheet.Calculate
strLocation = Range("B1").Value
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'Create new sheet for location and name it
ActiveSheet.Copy Before:=Sheets("Template")
ActiveSheet.Name = Trim(strLocation)

'Select cells and replace formulas with values
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Cells.Replace What:="0", Replacement:="0", LookAt:=xlPart,
SearchOrder:=xlByRows, MatchCase:=False
Range("A1").Select

'fill in the next line of the "YTD dir bonus summary" sheet
Sheets("YTD dir bonus summary").Select

ActiveSheet.Calculate
Rows("5:5").Select
Selection.Copy
Range("a" & Rows.Count).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Rows.Ungroup
'fill in the next line of the "YTD asst bonus summary" sheet
Sheets("YTD asst bonus summary").Select

ActiveSheet.Calculate
Rows("5:5").Select
Selection.Copy
Range("a" & Rows.Count).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Rows.Ungroup

Next

Sheets("YTD dir bonus summary").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("A1").Select

Sheets("YTD asst bonus summary").Select
ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("A1").Select

'Hide working sheets
Sheets("Template").Visible = False
Sheets("Instructions").Visible = False
Sheets("str list").Visible = False
Sheets("SOSP03").Visible = False
Sheets("SOSP03 YTD").Visible = False
Sheets("ident sales").Visible = False
Sheets("ident sales YTD").Visible = False
Sheets("not ident history").Visible = False
Sheets("SOSP04-Inv").Visible = False
Sheets("SOSP05-labor actuals").Visible = False
Sheets("SOSP05 YTD-labor actuals").Visible = False
Sheets("Gordy's labor bud").Visible = False
Sheets("Gordy's labor bud YTD").Visible = False
Sheets("Poulsen's P&G focus QTR").Visible = False
Sheets("Gary's bonus").Visible = False
Sheets("Hal's out of stock").Visible = False
Sheets("Cust 1st fr Mys Shop").Visible = False
Sheets("Sales Brackets").Visible = False
Sheets("Mys Shop Goals").Visible = False
Sheets("Key Retailing").Visible = False
Sheets("Rod's Turnover").Visible = False
Sheets("Mark's Safety").Visible = False
Sheets("Bill's Loyalty").Visible = False
Sheets("Points Summary").Visible = False
Sheets("scroll list").Visible = False

End Sub
Click to expand...

PTweenty,

You need to be more specific in your problem description. Stepping
through the macro with F8 should work just fine in Excel 2007. What
line of code does error 440 occur on? Your code has a lot of
unnecessary items in it. I haven't tested any of what is below, but
it should greatly simplify what you have. Repost a more descriptive
explanation of where you are encountering your error. Your post is
quite vague.

Best,

Matt Herbert

Sub RunReport()

Dim strLocation As String
Dim rngLoop As Range
Dim rngCell As Range
Dim wksTemp As Worksheet
Dim wksScroll As Worksheet
Dim wksNew As Worksheet
Dim wksDirBonus As Worksheet
Dim wksAstBonus As Worksheet
Dim rngfill As Range

'set the Template and Scroll List worksheets as objects
Set wksTemp = Sheets("Template")
Set wksScroll = Sheets("Scroll List")
Set wksDirBonus = Sheets("YTD dir bonus summary")
Set wksAstBonus = Sheets("YTD asst bonus summary")

'clear the old "YTD dir bonus summary" page
wksDirBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

'clear the old "YTD asst bonus summary" page
wksAstBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

'Select the list of stores (range) on "scroll list" sheet
With wksScroll
Set rngLoop = Range("a1", .Range("a1").End(xlDown))
End With

'show outline levels on wksTemp
wksTemp.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'Loop through each cell in rngLoop
For Each rngCell In rngLoop
With wksTemp
.Range("B1").Value = rngCell
.Calculate
strLocation = .Range("B1").Value
End With

'Create new sheet for strLocation and name it
wksTemp.Copy Before:=wksTemp
Set wksNew = ActiveSheet

With wksNew
.Name = Trim(strLocation)

'Select cells and replace formulas with values
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With

'fill in the next line of wksDirBonus
CopyToNext wksDirBonus

'fill in the next line of wksAstBonus
CopyToNext wksAstBonus
Next

wksDirBonus.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
wksAstBonus.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'What do your non-working sheets comprise? I'm sure there is a
' better way of hiding the working sheets.

'Hide working sheets
Sheets("Template").Visible = False
Sheets("Instructions").Visible = False
Sheets("str list").Visible = False
Sheets("SOSP03").Visible = False
Sheets("SOSP03 YTD").Visible = False
Sheets("ident sales").Visible = False
Sheets("ident sales YTD").Visible = False
Sheets("not ident history").Visible = False
Sheets("SOSP04-Inv").Visible = False
Sheets("SOSP05-labor actuals").Visible = False
Sheets("SOSP05 YTD-labor actuals").Visible = False
Sheets("Gordy's labor bud").Visible = False
Sheets("Gordy's labor bud YTD").Visible = False
Sheets("Poulsen's P&G focus QTR").Visible = False
Sheets("Gary's bonus").Visible = False
Sheets("Hal's out of stock").Visible = False
Sheets("Cust 1st fr Mys Shop").Visible = False
Sheets("Sales Brackets").Visible = False
Sheets("Mys Shop Goals").Visible = False
Sheets("Key Retailing").Visible = False
Sheets("Rod's Turnover").Visible = False
Sheets("Mark's Safety").Visible = False
Sheets("Bill's Loyalty").Visible = False
Sheets("Points Summary").Visible = False
Sheets("scroll list").Visible = False

End Sub

Sub CopyToNext(wks As Worksheet)

Dim rngfill As Range

With wks
.Calculate
Set rngfill = Nothing
Set rngfill = Range("A" & Rows.Count).End(xlUp)
Set rngfill = rngfill.Offset(1, 0)

Rows("5:5").Copy
rngfill.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

rngfill.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

'not sure what the line below is for

'Selection.Rows.Ungroup
End With

End Sub
 
M

meh2030

When you are working with ranges, you should be more specific with your
ranges' parent.  For example, the

Range("a9").End(xlDown)

from this line

wksDirBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

will be based on the active sheet, not wksDirBonus. The code should be, at
the very least

With wksDirBonus
 .Range("a9", .Range("a9").End(xlDown)).ClearContents
End With

Bernie


















PTweenty,

You need to be more specific in your problem description.  Stepping
through the macro with F8 should work just fine in Excel 2007.  What
line of code does error 440 occur on?  Your code has a lot of
unnecessary items in it.  I haven't tested any of what is below, but
it should greatly simplify what you have.  Repost a more descriptive
explanation of where you are encountering your error.  Your post is
quite vague.

Best,

Matt Herbert

Sub RunReport()

Dim strLocation As String
Dim rngLoop As Range
Dim rngCell As Range
Dim wksTemp As Worksheet
Dim wksScroll As Worksheet
Dim wksNew As Worksheet
Dim wksDirBonus As Worksheet
Dim wksAstBonus As Worksheet
Dim rngfill As Range

'set the Template and Scroll List worksheets as objects
Set wksTemp = Sheets("Template")
Set wksScroll = Sheets("Scroll List")
Set wksDirBonus = Sheets("YTD dir bonus summary")
Set wksAstBonus = Sheets("YTD asst bonus summary")

'clear the old "YTD dir bonus summary" page
wksDirBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

'clear the old "YTD asst bonus summary" page
wksAstBonus.Range("a9", Range("a9").End(xlDown)).ClearContents

'Select the list of stores (range) on "scroll list" sheet
With wksScroll
    Set rngLoop = Range("a1", .Range("a1").End(xlDown))
End With

'show outline levels on wksTemp
wksTemp.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'Loop through each cell in rngLoop
For Each rngCell In rngLoop
    With wksTemp
        .Range("B1").Value = rngCell
        .Calculate
        strLocation = .Range("B1").Value
    End With

    'Create new sheet for strLocation and name it
    wksTemp.Copy Before:=wksTemp
    Set wksNew = ActiveSheet

    With wksNew
        .Name = Trim(strLocation)

        'Select cells and replace formulas with values
        .Cells.Copy
        .Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End With

    'fill in the next line of wksDirBonus
    CopyToNext wksDirBonus

    'fill in the next line of wksAstBonus
    CopyToNext wksAstBonus
Next

wksDirBonus.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
wksAstBonus.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

'What do your non-working sheets comprise?  I'm sure there is a
' better way of hiding the working sheets.

'Hide working sheets
Sheets("Template").Visible = False
Sheets("Instructions").Visible = False
Sheets("str list").Visible = False
Sheets("SOSP03").Visible = False
Sheets("SOSP03 YTD").Visible = False
Sheets("ident sales").Visible = False
Sheets("ident sales YTD").Visible = False
Sheets("not ident history").Visible = False
Sheets("SOSP04-Inv").Visible = False
Sheets("SOSP05-labor actuals").Visible = False
Sheets("SOSP05 YTD-labor actuals").Visible = False
Sheets("Gordy's labor bud").Visible = False
Sheets("Gordy's labor bud YTD").Visible = False
Sheets("Poulsen's P&G focus QTR").Visible = False
Sheets("Gary's bonus").Visible = False
Sheets("Hal's out of stock").Visible = False
Sheets("Cust 1st fr Mys Shop").Visible = False
Sheets("Sales Brackets").Visible = False
Sheets("Mys Shop Goals").Visible = False
Sheets("Key Retailing").Visible = False
Sheets("Rod's Turnover").Visible = False
Sheets("Mark's Safety").Visible = False
Sheets("Bill's Loyalty").Visible = False
Sheets("Points Summary").Visible = False
Sheets("scroll list").Visible = False

End Sub

Sub CopyToNext(wks As Worksheet)

Dim rngfill As Range

With wks
    .Calculate
    Set rngfill = Nothing
    Set rngfill = Range("A" & Rows.Count).End(xlUp)
    Set rngfill = rngfill.Offset(1, 0)

    Rows("5:5").Copy
    rngfill.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
                         SkipBlanks:=False, Transpose:=False

    rngfill.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
                         SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False

    'not sure what the line below is for

    'Selection.Rows.Ungroup
End With

End Sub- Hide quoted text -

- Show quoted text -
Click to expand...

Bernie,

Thanks for the catch. I was simply quickly coding without testing
results or double checking syntax; poor effort on my part. (wksScroll
had the correct concept, minus the syntax error via not placing a "."
before Range, but I didn't apply the concept to wksDirBonus or
wksAstBonus). Thanks again for pointing this out.

Matt
 
P

pickytweety

Thanks so much for "cleaning" the code. It's not working yet, but I'm sure
it's just because you can't see the spreadsheet. What would the code be to
clear the contents of the entire row rather than just column A?

With wksDirBonus
.Range("a9", .Range("a9").End(xlDown)).ClearContents
End With
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

Excel not showing steps as I F8 through each line of VBA code 1
2002 vs 2007 MS Office Excel has encountered a problem and needs t 2
Excel 2000 SP3 versus Excel 2007 --error code 0Xc0000005 3
Can anybody get this code to perform on the correct worksheet? 7
Getting to the right worksheet 2
Run-time error 1004 paste method of worksheet class failed 3
Trying to "clean up" some code... 1
conso macro 0

Top