Help this VBA only working in one sheet not all workbook

linister

New Member
Joined
Jan 16, 2021
Messages
13
Office Version
  1. 2019
Platform
  1. Windows
Hi,

I have the following VBA which is meant to delete rows if the value in cell in column C equals 0

And it works but it's only applying to one sheet and i want it to run across the entire workbook


Sub RemoveRow()
Dim xSh As Worksheet
Application.ScreenUpdating = False
For Each xSh In Worksheets
xSh.Select
Call RunCode
Next
Application.ScreenUpdating = True
End Sub
Sub RunCode()
Columns("C:C").Select
Set rngRange = Selection.CurrentRegion
lngNumRows = rngRange.Rows.Count
lngFirstRow = rngRange.Row
lngLastRow = lngFirstRow + lngNumRows - 1
lngCompareColumn = ActiveCell.Column
For lngCurrentRow = lngLastRow To lngFirstRow Step -1
If (Cells(lngCurrentRow, lngCompareColumn).Text = "0") Then _
Rows(lngCurrentRow).Delete
Next lngCurrentRow
End Sub


What can be modified for it to work on the entire workbook
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,238
Office Version
  1. 2016
Platform
  1. Windows
Try this :
VBA Code:
Sub RemoveRow()
Dim xSh As Worksheet, rng As Range, r&
Application.ScreenUpdating = False
For Each xSh In Worksheets
    Set rng = Intersect(xSh.[C:C].CurrentRegion, xSh.[C:C])
    For r = rng.Rows.Count To rng(1).Row Step -1
        If rng(r).Text = 0 Then Rows(rng(r).Row).Delete
    Next
Next
Application.ScreenUpdating = True
End Sub
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,593
Office Version
  1. 2013
Platform
  1. Windows
Try this:
VBA Code:
Sub Filter_Me_Please()
Application.ScreenUpdating = False
'Modified  3/7/2021  3:18:06 AM  EDT
Dim lastrow As Long
Dim c As Long
Dim s As Variant
c = 3 ' Column Number Modify this to your need
s = 0 'Search Value Modify to your need

    For i = 1 To Sheets.Count
        lastrow = Sheets(i).Cells(Rows.Count, c).End(xlUp).Row

        With Sheets(i).Cells(1, c).Resize(lastrow)
            .AutoFilter 1, s
            counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
                If counter > 1 Then
                    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
                Else
                    MsgBox "No values found"
                End If
                .AutoFilter
        End With
    Next
Application.ScreenUpdating = True
End Sub
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,523
Office Version
  1. 2019
Platform
  1. Windows
Hi,
see if this update to your code does what you want

VBA Code:
Sub RemoveRow()
    Dim xSh As Worksheet
    Application.ScreenUpdating = False
        For Each xSh In Worksheets
            xSh.Select
            Call RunCode(xSh)
        Next
    Application.ScreenUpdating = True
End Sub

Sub RunCode(ByVal sh As Object)
    Dim DeleteRow   As Range, cell As Range
    Dim rng         As Range
  
    Set rng = sh.Range(sh.Range("C1"), sh.Range("C" & sh.Rows.Count).End(xlUp))
    For Each cell In rng.Cells
        If Val(cell.Value) = 0 Then
            If DeleteRow Is Nothing Then
                Set DeleteRow = cell
            Else
                Set DeleteRow = Union(DeleteRow, cell)
            End If
        End If
    Next cell
       
    If Not DeleteRow Is Nothing Then DeleteRow.EntireRow.Delete
    Set DeleteRow = Nothing
End Sub

Dave
 

linister

New Member
Joined
Jan 16, 2021
Messages
13
Office Version
  1. 2019
Platform
  1. Windows
Hi guys,

Thanks for your efforts, turns out i just needed to change:
Dim xSh As Worksheet
to
Dim Ws As Worksheet

and it worked as i wanted.🤦‍♀️
 

footoo

Well-known Member
Joined
Sep 21, 2016
Messages
3,238
Office Version
  1. 2016
Platform
  1. Windows
Revised :
VBA Code:
Sub RemoveRow()
Dim xSh As Worksheet, rng As Range, r&
Application.ScreenUpdating = False
For Each xSh In Worksheets
    Set rng = Intersect(xSh.[C:C].CurrentRegion, xSh.[C:C])
    For r = rng.Rows.Count To rng(1).Row Step -1
        If rng(r).Text = 0 Then xSh.Rows(rng(r).Row).Delete
    Next
Next
Application.ScreenUpdating = True
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,130,181
Messages
5,640,649
Members
417,159
Latest member
Mayozero

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