Can anybody get this code to perform on the correct worksheet?

P

pickytweety

Hi,
This is code that Matt Herbert so kindly wrote for me. On line 111, near
the bottom, I think it's not referring to the right worksheet in the
workbook. I think it's stuck on the new sheet that was created as opposed to
wksDirBonus. Why isn't the "CopyToNext wksDirBonus" pointing it to the
correct place for pasting row 5? (In other words, row 5 in the wksDirBonus
should get pasted as values into the same worksheet, just further down, with
each item in the rngLoop.)
--
Thanks,
PTweety

PS Matt, if you happen to see this, I really appreciate you taking the time
to write this. I have so many files now that I need to go back and clean up.
Your advice will make my work much more efficient. Thank you. Is rating
the post just clicking "Yes" or "No"? I never did get to a place that let me
rate your awesome response. Thanks to Bernie Deitrick too.

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
With wksDirBonus
.Range("a9", .Range("a9").End(xlDown)).EntireRow.ClearContents
End With
'clear the old "YTD asst bonus summary" page
With wksAstBonus
.Range("a9", Range("a9").End(xlDown)).EntireRow.ClearContents
End With
'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

'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) 'tried this with & without the period before "Range"
Set rngfill = rngfill.Offset(1, 0)

Rows("5:5").Copy
Line111 rngfill.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
 
B

Barb Reinhardt

I thought i posted this before, but I don't see it.

change

Set rngfill = Range("A" & Rows.Count).End(xlUp) 'tried this with & without
the period before "Range"

to

Set rngfill = .Range("A" & .Rows.Count).End(xlUp)

I'm guessing you want rngfill to pulled from the defined worksheet.

HTH,
Barb Reinhardt

'tried this with & without the period before "Range"
 
J

john

Code needs properly qualifying with the missing periods “.†(full stops)
Also, are you sure you are passing the correct sheet name to your argument
Sub CopyToNext(wks As Worksheet)?

I ran your code fully qualified as below & all seemed ok.

Sub CopyToNext(wks As Worksheet)

Dim rngfill As Range

With wks
.Calculate
Set rngfill = Nothing
Set rngfill = .Range("A" & Rows.Count).End(xlUp) 'tried this with &
without the period before "Range"

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
End With
End Sub

I tested like this and all seemed ok.

Sub atest()
CopyToNext Sheet1
End Sub
 
J

john

whoops missed one!

Set rngfill = .Range("A" & .Rows.Count).End(xlUp)

there should be a period in front of Rows
 
P

pickytweety

Tried a period in front of both Range and Rows but it's not working. When it
tries to paste the row, it tells me it can't because of non-identical sized
merged cells. However there are no merged cells in the sheet associated with
wksDirBonus. So I put a watch on rngfill and it gives me a cell in the sheet
called 030 which happens to be the value of the strLocation variable. So
it's trying to paste to the wrong sheet altogether.
 
P

pickytweety

Hi Bob, I think you did post it, and I tried a period in front of both Range
and Rows but it's not working. When it tries to paste the row, it tells me
it can't because of non-identical sized merged cells. However there are no
merged cells in the sheet associated with wksDirBonus. So I put a watch on
rngfill and it gives me a cell in the sheet called 030 which happens to be
the value of the strLocation variable. So it's trying to paste to the wrong
sheet altogether.
 
J

john

I trided your code again and it seems to work for me.
I have added a msgbox so you can see which sheet you are accessing.

If still fails, do as I did by adding some of your data & this code to a new
workbook & test that, if it works as you intended then there is something
like merged cells going on in your worksheet which would most likely cause
your problem.

Other than this, it's really difficult to determine what else you are doing
differently to cause the problem.

Sub CopyToNext(wks As Worksheet)

Dim rngfill As Range

MsgBox wks.Name '<< test only rem or delete when not need

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
End With
End Sub

'I tested like this and all seemed ok.

Sub atest()
Dim wksAstBonus As Worksheet
Set wksAstBonus = Sheets("YTD asst bonus summary")
CopyToNext wksAstBonus
End Sub
 
J

john

you could give this approach a try.

Sub CopyToNext(wks As Worksheet)

Dim rng As Range

With wks
'Assuming data starts in A1 and there
'are no blank rows or columns embedded
Set rng = .Range("A1").CurrentRegion

numrows = rng.Rows.Count
numcols = rng.Columns.Count

.Calculate

.Range(Cells(5, 1), Cells(5, numcols)).Copy

.Range("A" & numrows + 1).PasteSpecial xlPasteValues, , False, False
.Range("A" & numrows + 1).PasteSpecial xlFormats, , False, False
'
Application.CutCopyMode = False
End With
End Sub
 

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

Top