how to write VBA code to apply a macro to multiple worksheets

[jia22]

Hello Everyone!
I have a code here(please find below) and was wondering if you could help out.

I am using this code to delete all the blank rows in a worksheet , and this code works fine.

The problem I am Having is that, when I run the code it only does it for the current worksheet I am on. I have around 13 worksheets and was wondering if it could be applied to all the active worksheets when I run the macro once, without having to run the macro for each worksheet.

Any help is much appreciated! Thank you in advance!






Public Sub DeleteRowFINAL()

Application.ScreenUpdating = False


For Each usedrng In ActiveSheet.UsedRange

If usedrng.MergeCells = True Then
If usedrng.Value = "" Then
usedrng.Value = ""
End If
Else
If usedrng.Value = "" Then
usedrng.ClearContents
End If
End If
Next

ActiveSheet.UsedRange
usedRangeLastColNum = ActiveSheet.UsedRange.Columns.<wbr>Count
usedrangelastrow = ActiveSheet.UsedRange.Rows.<wbr>Count


For r = usedrangelastrow To 1 Step -1
If Application.WorksheetFunction.<wbr>CountA(Cells(r, usedRangeLastColNum).<wbr>EntireRow) <> 0 Then

Exit For
Else
Cells(r, usedRangeLastColNum).<wbr>EntireRow.Delete
End If
Next r

For c = usedRangeLastColNum To 1 Step -1
If Application.WorksheetFunction.<wbr>CountA(Cells(1, c).EntireColumn) <> 0 Then

Exit For
Else
Cells(1, c).EntireColumn.Delete
End If
Next c

ActiveSheet.UsedRange
Application.ScreenUpdating = True

Dim rgCol As Range


On Error Resume Next


For Each rgCol In Range("A2:G102").Columns
rgCol.SpecialCells(<wbr>xlCellTypeBlanks).EntireRow.<wbr>Delete
Next rgCol




End Sub

 

[Michael M]

Don't have Excel at the moment but try...

Public Sub DeleteRowFINAL()
Dim r As Variant, lr As Long, ws as worksheet
Application.ScreenUpdating = False
    For Each ws In Worksheets
    ws.Activate
    lr = Cells(Rows.Count, "A").End(xlUp).Row
        For Each r In Range("A2:A" & lr)
            r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        Next r
    Next ws
Application.ScreenUpdating = True
End Sub

 

[jia22]

Hi Michael,

I tired your but it didn't seem to have worked, Could maybe I edited your code in the wrong place? Please see below.

Thank you.


Public Sub DeleteRowFINAL()
Dim r As Variant, lr As Long, ws As Worksheet
Application.ScreenUpdating = False


For Each ws In Worksheets
ws.Activate
lr = Cells(Rows.Count, "A").End(xlUp).Row
For Each r In Range("A2:A" & lr)
r.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next r
Next ws


For Each usedrng In ActiveSheet.UsedRange


If usedrng.MergeCells = True Then
If usedrng.Value = "" Then
usedrng.Value = ""
End If
Else
If usedrng.Value = "" Then
usedrng.ClearContents
End If
End If
Next


ActiveSheet.UsedRange
usedRangeLastColNum = ActiveSheet.UsedRange.Columns.Count
usedrangelastrow = ActiveSheet.UsedRange.Rows.Count




For r = usedrangelastrow To 1 Step -1
If Application.WorksheetFunction.CountA(Cells(r, usedRangeLastColNum).EntireRow) <> 0 Then


Exit For
Else
Cells(r, usedRangeLastColNum).EntireRow.Delete
End If
Next r


For c = usedRangeLastColNum To 1 Step -1
If Application.WorksheetFunction.CountA(Cells(1, c).EntireColumn) <> 0 Then


Exit For
Else
Cells(1, c).EntireColumn.Delete
End If
Next c


ActiveSheet.UsedRange
Application.ScreenUpdating = True


Dim rgCol As Range




On Error Resume Next




For Each rgCol In Range("A2:G102").Columns
rgCol.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next rgCol








End Sub

 

[Norie]

Re: Applying macro/vba to run on multiple worksheets and not only the current worksheet

Try this.

Option Explicit

Public Sub DeleteRowFINAL()
Dim ws As Worksheet
Dim rgCol As Range
Dim usedrng As Range
Dim c As Long
Dim r As Long
Dim usedRangeLastColNum As Long
Dim usedrangelastrow As Long

    Application.ScreenUpdating = False

    For Each ws In ActiveWorkbook.Sheets

        With ws
            For Each usedrng In .UsedRange

                If usedrng.MergeCells = True Then
                    If usedrng.Value = "" Then
                        usedrng.Value = ""
                    End If
                Else
                    If usedrng.Value = "" Then
                        usedrng.ClearContents
                    End If
                End If
            Next

            usedRangeLastColNum = .UsedRange.Columns.Count
            usedrangelastrow = .UsedRange.Rows.Count

            For r = usedrangelastrow To 1 Step -1
                If Application.CountA(.Cells(r, usedRangeLastColNum).EntireRow) <> 0 Then
                    Exit For
                Else
                    .Cells(r, usedRangeLastColNum).EntireRow.Delete
                End If
            Next r

            For c = usedRangeLastColNum To 1 Step -1
                If Application.CountA(.Cells(1, c).EntireColumn) <> 0 Then
                    Exit For
                Else
                    .Cells(1, c).EntireColumn.Delete
                End If
            Next c

            On Error Resume Next

            For Each rgCol In .Range("A2:G102").Columns
                rgCol.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            Next rgCol

            On Error GoTo 0

        End With

    Next ws

    Application.ScreenUpdating = True
    
End Sub

 

[jia22]

Re: Applying macro/vba to run on multiple worksheets and not only the current worksheet

Hi Norie,

Thank you for the quick response.

I just tried your code and its throwing me an error on one of the lines.

I have highlighted it in Red below.

Thank you again for all your help!

Public Sub DeleteRowFINAL()
Dim ws As Worksheet
Dim rgCol As Range
Dim usedrng As Range
Dim c As Long
Dim r As Long
Dim usedRangeLastColNum As Long
Dim usedrangelastrow As Long

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Sheets

With ws
For Each usedrng In .UsedRange

If usedrng.MergeCells = True Then
If usedrng.Value = "" Then
usedrng.Value = ""
End If
Else

If usedrng.Value = "" Then

usedrng.ClearContents
End If
End If
Next

usedRangeLastColNum = .UsedRange.Columns.Count
usedrangelastrow = .UsedRange.Rows.Count

For r = usedrangelastrow To 1 Step -1
If Application.CountA(.Cells(r, usedRangeLastColNum).EntireRow) <> 0 Then
Exit For
Else
.Cells(r, usedRangeLastColNum).EntireRow.Delete
End If
Next r

For c = usedRangeLastColNum To 1 Step -1
If Application.CountA(.Cells(1, c).EntireColumn) <> 0 Then
Exit For
Else
.Cells(1, c).EntireColumn.Delete
End If
Next c

On Error Resume Next

For Each rgCol In .Range("A2:G102").Columns
rgCol.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next rgCol

On Error GoTo 0

End With

Next ws

Application.ScreenUpdating = True

End Sub
​

​

****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

Public Sub DeleteRowFINAL()
Dim ws As Worksheet
Dim rgCol As Range
Dim usedrng As Range
Dim c As Long
Dim r As Long
Dim usedRangeLastColNum As Long
Dim usedrangelastrow As Long

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Sheets

With ws
For Each usedrng In .UsedRange

If usedrng.MergeCells = True Then
If usedrng.Value = "" Then
usedrng.Value = ""
End If
Else
If usedrng.Value = "" Then
usedrng.ClearContents
End If
End If
Next

usedRangeLastColNum = .UsedRange.Columns.Count
usedrangelastrow = .UsedRange.Rows.Count

For r = usedrangelastrow To 1 Step -1
If Application.CountA(.Cells(r, usedRangeLastColNum).EntireRow) <> 0 Then
Exit For
Else
.Cells(r, usedRangeLastColNum).EntireRow.Delete
End If
Next r

For c = usedRangeLastColNum To 1 Step -1
If Application.CountA(.Cells(1, c).EntireColumn) <> 0 Then
Exit For
Else
.Cells(1, c).EntireColumn.Delete
End If
Next c

On Error Resume Next

For Each rgCol In .Range("A2:G102").Columns
rgCol.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next rgCol

On Error GoTo 0

End With

Next ws

Application.ScreenUpdating = True

End Sub
​

If posting code please use code tags.
​

</body>

 

[Norie]

Re: Applying macro/vba to run on multiple worksheets and not only the current worksheet

And the error is?

 

[jia22]

Re: Applying macro/vba to run on multiple worksheets and not only the current worksheet

Type mismatch

 

[Norie]

Re: Applying macro/vba to run on multiple worksheets and not only the current worksheet

Try using usedrng.Cells(1,1).Value instead of If usedrng.Value.