P
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
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