Run Macro on All Worksheets in a workbook

[famehunter]

I have about 150 Worksheets in one Workbook. In all these sheets, I
need to delete the blank rows. I've already have a macro for that
purpose. Now I'm trying to figure out another macro for executing the
DeleteBlankRows macro on all the 150 worksheets. The code I have so far
only works on the active worksheet. I would really appreciate any help.
-------------------------------------------------
Sub DeleteBlankRows()

Cells.Select

Dim i As Long

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

-----------------------------------------
this is what I have so far for the other Macro:

Sub DeleteBlanksAllSheets()

Dim wk As Worksheet
For Each wk In ActiveWorkbook.Sheets

Call DeleteBlankRows

Next wk

End Sub

 

[Ron de Bruin]

Hi

Not loop through all cells of the worksheet but use the usedrange

Try this example for the workbook with the code

Sub Example1()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Dim sh As Worksheet

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

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

For Each sh In ThisWorkbook.Worksheets

Firstrow = sh.UsedRange.Cells(1).Row
Lastrow = sh.UsedRange.Rows.Count + Firstrow - 1

With sh
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1

If Application.CountA(.Rows(Lrow)) = 0 Then
..Rows(Lrow).Delete

Next
End With

Next sh

ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

 

[John]

Dear Famous,

You just need to pass the worksheet object in your call statement:

Sub DeleteBlanksAllSheets()
Dim wk As Worksheet
For Each wk In ActiveWorkbook.Sheets
Call DeleteBlankRows(wk)
Next wk
End Sub

Sub DeleteBlankRows(ByRef wks As Worksheet)
Dim i As Long
wks.Cells.Select
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Best regards

John

 

[famehunter]

I get run time error 1004
select method of range class failed

for this line: wks.Cells.Select

I also tried just Cell.Select, but it would only work for the active
sheet in that case.

 

[Chip Pearson]

The problem lies in the line of code

wks.Cells.Select

Here, the worksheet referenced by wks is not the active sheet, and you
cannot select cells that are not on the active sheet. You'll want to select
the worksheet before selecting cells on it. E.g.,

wks.Select
wks.Cells.Select


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)

 

[famehunter]

Thanks for your help. I got it to work after moving wk.Cells.Select to
the other macro like this:

Sub DeleteBlanksAllSheets()
Dim wk As Worksheet
For Each wk In ActiveWorkbook.Sheets
wk.Select
wk.Cells.Select
Call DeleteBlankRows(wk)
Next wk
End Sub

Sub DeleteBlankRows(ByRef wk As Worksheet)
Dim i As Long

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[John]

Hi, works for me I'm afraid.

Check the worksheet object is being passed through correctly. Step through
the code one line at a time (F8 key) and look at the Locals window
(View/Locals Window) to check that the wks object isn't empty.

My guess is it's just a typo. Did you cut and paste the code of modify what
you had?

Hope that helps

Best regards

John

 

[John]

Thanks for the correction, Chip

Apologies to Famous. I guess I didn't run beyond the first sheet, which
happened to be active.

Best regards

John