Loop with loops

teatimecrumpet

Active Member
Joined
Jun 23, 2010
Messages
307
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
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Weaver

Well-known Member
Joined
Sep 10, 2008
Messages
5,196
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

Code:
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

Well-known Member
Joined
May 19, 2002
Messages
8,458
ok so add this to the start of your macro
Code:
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
Code:
Next i
Application.ScreenUpdating = True
 

njimack

Well-known Member
Joined
Jun 17, 2005
Messages
7,764
You need to qualify your ranges. Something like this:

Code:
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

Active Member
Joined
Jun 23, 2010
Messages
307
Hey Tex,

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

ok so add this to the start of your macro
Code:
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
Code:
Next i
Application.ScreenUpdating = True
 

teatimecrumpet

Active Member
Joined
Jun 23, 2010
Messages
307
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
 

Forum statistics

Threads
1,147,451
Messages
5,741,195
Members
423,647
Latest member
lyanndominique

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top