Loop with loops

[teatimecrumpet]

Hi I'm trying to run the below code that would go through each worksheet and run some code But it's only running the code for the initial activated worksheet.

Any thoughts?

Sub totaldelete()
For Each Worksheet In ActiveWorkbook.Worksheets

Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Deletes rows above cell that contains the text Yellow
Dim foundOne As Range
On Error Resume Next
With ActiveWorkbook.ActiveSheet
Set foundOne = .Range("A:A").Find(What:="Yellow", After:=.Range("a1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If foundOne.Row > 1 Then
Range(.Range("a1"), foundOne.Offset(-1, 0)).EntireRow.Delete shift:=xlUp
End If
End With
On Error GoTo 0

'gets rid of merged cells
Cells.Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

'searches each row for the word "total" and deletes that row
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If LCase(Cells(i, 1).Value) = "total" Then _
Cells(i, "A").EntireRow.Delete
Next

Next Worksheet

End Sub

 

[Weaver]

Cells.Select just refers to the cells in the currently active worksheet and since your code does't actually change that, then that'll be your problem

for each ws in activeworkbook.worksheets '(best not to use reserved words for variable names)
   with ws.cells
      .VerticalAlignment = xlBottom
      .WrapText = False
      .Orientation = 0
      .AddIndent = False
      .ShrinkToFit = False
      .ReadingOrder = xlContext
      .MergeCells = False
    end with
next ws

You should be able to figure out the rest.
Hope that helps

 

[texasalynn]

ok so add this to the start of your macro

Dim WSCount As Long, i As Long, x As Long
WSCount = Worksheets.Count
Application.ScreenUpdating = False
For i = 1 To WSCount
       Sheets(ws).Activate

then at the end add

Next i
Application.ScreenUpdating = True

 

[njimack]

You need to qualify your ranges. Something like this:

Sub totaldelete()
Dim ws As Worksheet
Dim foundOne As Range
Dim i As Long
For Each ws In ActiveWorkbook.Worksheets

    With [COLOR="Red"]ws.Cells[/COLOR]
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

'Deletes rows above cell that contains the text Yellow

On Error Resume Next
With ActiveWorkbook.ActiveSheet
Set foundOne = .Range("A:A").Find(What:="Yellow", After:=.Range("a1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If foundOne.Row > 1 Then
Range(.Range("a1"), foundOne.Offset(-1, 0)).EntireRow.Delete shift:=xlUp
End If
End With
On Error GoTo 0

'gets rid of merged cells
[COLOR="Red"]With ws.Cells[/COLOR]
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False


    'searches each row for the word "total" and deletes that row
    For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        If LCase(.Cells(i, 1).Value) = "total" Then _
        .Cells(i, "A").EntireRow.Delete
    Next

End With

Next ws

End Sub

 

[teatimecrumpet]

Hey Tex,

I'm getting "subscript out of range" at: Sheets(ws).activate

ok so add this to the start of your macro

Dim WSCount As Long, i As Long, x As Long
WSCount = Worksheets.Count
Application.ScreenUpdating = False
For i = 1 To WSCount
       Sheets(ws).Activate

then at the end add

Next i
Application.ScreenUpdating = True

 

[teatimecrumpet]

Hi All,

THANKS FOR THE HELP! All i needed to do was add a "ws." to anything that was referring to an active sheet.

In purple is where I had some trouble getting this to work with the filldown and the selection of a dynamic range. so I used "WS.activate". I also had to add the error handler in instances where a filldown would have selected a blank cell before filldown.

Of course I'm not sure if this is good coding style but please let me know if you have a better idea for doing the filldown.

Again THANKS FOR EVERYTHING!

Sub totaldelete____123()

For Each ws In ActiveWorkbook.Worksheets
With ws.Cells
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Deletes rows above cell that contains the text Yellow
Dim foundOne As Range
On Error Resume Next
With ActiveWorkbook.ActiveSheet
Set foundOne = ws.Range("A:A").Find(What:="Yellow", After:=.Range("a1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If foundOne.Row > 1 Then
Range(ws.Range("a1"), foundOne.Offset(-1, 0)).EntireRow.Delete shift:=xlUp
End If
End With
On Error GoTo 0

For y = 1 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If LCase(ws.Cells(y, 1).Value) = "total" Then _
ws.Cells(y, "A").EntireRow.Delete
Next y

On Error Resume Next
ws.Activate
With ws
.Range("A2").Copy Destination:=ws.Range("C4")
.Range("B1048576").End(xlUp).Offset(0, 1).Select
.Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
End With
Next ws
On Error GoTo 0

End Sub