Help this VBA only working in one sheet not all workbook

[linister]

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

 

[footoo]

Try this :

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]

Try this:

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]

Hi,
see if this update to your code does what you want

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]

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]

Revised :

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