Trying to "clean up" some code...

[pickytweety]

I was trying to "clean up" some code based on new examples that I got but I'm
not getting the result that I want in the Summary page. I'm giving you two
versions of the code. The first version works fine but isn't well written
because it's mostly recorded. Version two trys to clean it up, but
something's not right because the summary worksheet ends up with just a
column of store numbers and no data (row 3) for each store.



This is version 1 that works, but has all kinds of unneccessary stmts:

Sub runScores()

Dim perBottom As Integer
Dim strBottom As Integer
Dim strLocation As String

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

'Select the list of periods (range) on "scroll list" sheet
Sheets("scroll list").Activate
Range("b1").Select
Selection.End(xlDown).Select
perBottom = ActiveCell.Row



'Loop through each period
For Each Period In Range("b1:b" & perBottom)
Sheets("scroll list").Select
currPeriod = Period.Value
Sheets("Template").Select
Range("g6").Value = currPeriod
'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

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

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

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

ActiveSheet.Calculate
Rows("3:3").Select
Selection.Copy
Range("a65000").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 store
Next Period

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

End Sub





This is version 2 where I tried to "clean up" version 1:

The macro runs but the summary sheet has store numbers but no calculations
filled in.

Sub runScores()

Dim wksSummary As Worksheet
Dim wksScroll As Worksheet
Dim perCell As Range
Dim perLoop As Range
Dim strCell As Range
Dim strLoop As Range
Dim wksTemplate As Worksheet

Set wksScroll = Sheets("scroll list")
Set wksTemplate = Sheets("Template")
Set wksSummary = Sheets("summary")


'clear the old "summary" page
With wksSummary
.Range("a7", .Range("a7").End(xlDown)).EntireRow.ClearContents
End With


'Select the list of periods (range) on "scroll list" sheet
With wksScroll
Set perLoop = .Range("b1", .Range("b1").End(xlDown))
End With

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

'Loop through each period/str
For Each perCell In perLoop
With wksTemplate
.Range("g6").Value = perCell
End With
For Each strCell In strLoop
With wksTemplate
.Range("b1").Value = strCell
.Calculate
strLocation = .Range("B1").Value
End With
CopyToNext wksSummary 'fill in the next line of the "summary" sheet
Next strCell
Next perCell

wksSummary.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("a1").Select

End Sub


Sub CopyToNext(wks As Worksheet)

Dim rngfill As Range

'MsgBox wks.Name

With wks
..Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
..Calculate
Set rngfill = Nothing
Set rngfill = .Range("A" & .Rows.Count).End(xlUp)
Set rngfill = rngfill.Offset(1, 0)

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

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

Application.CutCopyMode = False


End With

End Sub

 

[Per Jessen]

Not sure, but I think you have to use a sheet reference when the macro copy
row 3 in the CopyTo macro. I don't see what your are using the strLocaton
variable for:

Sub runScores1()

Dim wksSummary As Worksheet
Dim wksScroll As Worksheet
Dim wksTemplate As Worksheet
Dim perCell As Range
Dim perLoop As Range
Dim strCell As Range
Dim strLoop As Range

Set wksScroll = Worksheets("scroll list")
Set wksTemplate = Worksheets("Template")
Set wksSummary = Worksheets("summary")

'clear the old "summary" page
With wksSummary
.Range("a7", .Range("a7").End(xlDown)).EntireRow.ClearContents
End With


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

'Loop through each period/str
For Each perCell In perLoop
wksTemplate.Range("g6").Value = perCell

For Each strCell In strLoop
With wksTemplate
.Range("b1").Value = strCell
.Calculate
strLocation = .Range("B1").Value
End With
Call CopyToNext(wksSummary) 'fill in the next line of the "summary"
sheet
Next strCell
Next perCell

wksSummary.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1
Range("a1").Select

End Sub


Sub CopyToNext(wks As Worksheet)

Dim RngFill As Range

'MsgBox wks.Name

With wks
.Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
.Calculate

Set RngFill = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)

wks.Rows("3:3").Copy
RngFill.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

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

Application.CutCopyMode = False
End With
Set RngFill = Nothing
End Sub

Regards,
Per