PDA

View Full Version : When looping through sheets remove subtotals only works on first



agnesz
06-17-2008, 06:50 AM
I have the following code that needs to run through about 10 sheets that are subtotaled. First the code needs to remove subtotals and then delete specific rows. For some reason, the code only works on the fisrt tab??? Any ideas why? This is so frustrating!!!!!!!!!!! Please help!

Sub WorksheetLoop()
Windows("MondayMorningTemplate.xls").Activate

Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
SetUpReport
' The following line shows how to reference a sheet within
' the loop by displaying the worksheet name in a dialog box.
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub

Sub SetUpReport()

ActiveSheet.Outline.ShowLevels RowLevels:=3

Cells.Select
Selection.RemoveSubtotal

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.Select

'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(8).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

For Lrow = Lastrow To Firstrow Step -1

With .Cells(Lrow, "B")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "3<= 80%", "4<= 100%", "5 NEW", "Total Excluding New Receipts / Cont % TTL": .EntireRow.Delete
End Select

End If
End With
Next Lrow
End With

Calculate
End Sub

Tommy
06-17-2008, 06:59 AM
This should fix it :)


Sub WorksheetLoop()
Windows("MondayMorningTemplate.xls").Activate

Dim WS_Count As Integer
Dim I As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For I = 1 To WS_Count
ActiveWorkbook.Worksheets(I).Activate
SetUpReport
' The following line shows how to reference a sheet within
' the loop by displaying the worksheet name in a dialog box.
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub

agnesz
06-17-2008, 07:01 AM
I'm trying to run a macro which removes subtotals and then deletes specific rows of data on a bunch of worksheets and for some reason the loop only performs required action on the fisrt tab. I can see it moving through the rest of the worksheets but it doesn't do the removing of subtotals and deleting. This is so frustrating! Any help would be much appreciated.

Sub SetUpReport()

ActiveSheet.Outline.ShowLevels RowLevels:=3

Cells.Select
Selection.RemoveSubtotal

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.Select

Firstrow = .UsedRange.Cells(8).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

For Lrow = Lastrow To Firstrow Step -1

With .Cells(Lrow, "B")
If Not IsError(.Value) Then
Select Case .Value
Case Is = "3<= 80%", "4<= 100%", "5 NEW", "Total Excluding New Receipts / Cont % TTL": .EntireRow.Delete
End Select
End If
End With
Next Lrow
End With

Calculate

End Sub


Sub WorksheetLoop()
Windows("MondayMorningTemplate.xls").Activate

Dim WS_Count As Integer
Dim I As Integer

WS_Count = ActiveWorkbook.Worksheets.Count

For I = 1 To WS_Count

SetUpReport

MsgBox ActiveWorkbook.Worksheets(I).Name

Next I

End Sub

lucas
06-17-2008, 07:44 AM
Threads merged. Agnes, creating a new thread with the same question will not get you double resuts......in fact it will likely get your question ignored.

How would you like it if you spent time trying to work out a problem for someone just to find that they had asked the same question twice and it had already been answered in the other thread...

Please be considerate of our contributors. Remember, your question is no more important than anyone elses.

Tommy
06-17-2008, 07:50 AM
Crud I keep forgetting I can merge the questions also.

lucas
06-17-2008, 07:52 AM
Hey Tommy, Hows the new job?

Tommy
06-17-2008, 08:01 AM
Working hard for my nickles :)

checking steel for 11 hrs and driving for 2 hrs makes for a long day :)