Loop a Macro Through all Sheets-CodePudding

I want to loop this macro through all sheets. The macro current works on just one sheet but when I try to add a For Next loop it says the variable is not defined. Basically, I want it to find the text "Total Capital" and delete everything below it for all but two sheets in the workbook. Thank you in advance. This is what I have currently.

Sub DeleteBelowCap()
Dim ws As Worksheet
For Each ws In Worksheets
Dim lngFirstRow As Long, lngLastRow As Long
Dim lngCount As Long
Dim fRg As Range
 Set fRg = Cells.Find(what:="Total Capital", lookat:=xlWhole)
 lngFirstRow = fRg.Row   1
 lngLastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
 For lngCount = lngLastRow To lngFirstRow Step -1
     Rows(lngCount).EntireRow.Delete
 Next lngCount
 Set fRg = Nothing
Next
End Sub

CodePudding user response：

You must be careful since you are looping worksheets NOT to use references like ActiveSheet in your code, or unqualified range references. We see this in two places in your code:

lngLastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

and

Set fRg = Cells.Find(what:="Total Capital", lookat:=xlWhole)

Both of these spell trouble - you will be working on the activesheet in both cases, I think. Or in the latter case, possibly on the worksheet module the code is in (if it is in a worksheet module and not a standard code module).

So, fixes in place:

Sub DeleteBelowCap()

Dim lngFirstRow As Long
Dim lngLastRow As Long
Dim lngCount As Long
Dim fRg As Range
Dim ws As Worksheet

For Each ws In Worksheets
     Set fRg = ws.Cells.Find(What:="Total Capital", LookAt:=xlWhole)
     If Not fRg Is Nothing Then
        lngFirstRow = fRg.Row   1
        lngLastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
        ws.Range(ws.Cells(lngFirstRow, 1), ws.Cells(lngLastRow, 1)).EntireRow.Delete
     End If
     Set fRg = Nothing
Next

End Sub

I'm not a fan of deleting rows, especially row by row. So if your goal is just to clear everything below the found cell, then using a clear method is simple without any extra logic (all the way to the bottom):

Sub DeleteBelowCap2()

Dim fRg As Range
Dim ws As Worksheet

For Each ws In Worksheets
     Set fRg = ws.Cells.Find(What:="Total Capital", LookAt:=xlWhole)
     If Not fRg Is Nothing Then
        ws.Range(ws.Cells(fRg.Row   1, 1), ws.Cells(Rows.Count, 1)).EntireRow.Clear
     End If
     Set fRg = Nothing
Next
End Sub

CodePudding user response：

Clear Below the First Found Cell

Option Explicit

Sub ClearBelowCap()
    
    Const SearchString As String = "Total Capital"
    Const ExceptionsList As String = "Sheet1,Sheet2"
    
    Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet
    
    For Each ws In wb.Worksheets
        If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
            ClearBelowFirstFoundCell ws, SearchString
        End If
    Next ws

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      In a worksheet ('ws'), clears the cells in the rows
'               that are below the row of the top-most cell
'               whose contents are equal to a string ('SearchString').
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ClearBelowFirstFoundCell( _
        ByVal ws As Worksheet, _
        ByVal SearchString As String)
    If ws.FilterMode Then ws.ShowAllData
    With ws.UsedRange
        Dim lCell As Range: Set lCell = .Cells(.Rows.Count, .Columns.Count)
        Dim fCell As Range
        Set fCell = .Find(SearchString, lCell, xlFormulas, xlWhole)
        If fCell Is Nothing Then Exit Sub
        Dim fRow As Long: fRow = fCell.Row
        Dim lRow As Long: lRow = lCell.Row
        If lRow = fRow Then Exit Sub
        .Resize(lRow - fRow).Offset(fRow - .Row   1).Clear ' .Delete xlShiftUp
    End With
End Sub