VBA - Deleting Rows-CodePudding

I'm using a macro that is running into an error (Invalid qualifier) pointing that there is something wrong with the i variable. Hope someone could help me improve this code.

Sub Macro6()

Dim last As Long
Dim i As Long
    With ActiveSheet
        last = .Cells(.Rows.Count, 1).End(xlDown).Row
    For i = last To 1 Step -1
        If .Cells(i, 1).Value Like "X" Then
            .Cells(i.End(xlDown), 1).EntireRow.Delete
        End If
    Next i

This macro is supposed to identify cell with value "X" (that will be located at the end of column A) and then delete all rows below that are empty.

Hope someone could help me.

Many thanks!

CodePudding user response：

I'd suggest you skip the loop, and use Range.Find instead.

Sub DeleteAllAfterX()
   With ActiveSheet
       Dim rng As Range
       Set rng = .Range("A:A").Find(What:="X", LookIn:=xlValues, Lookat:=xlWhole)

       If Not rng Is Nothing Then
           .Rows(rng.Row & ":" & .Rows.Count).ClearContents
       End If
   End With
End Sub

CodePudding user response：

Delete Below String

Application.Match

If you are expecting one occurrence of the string or you're after the first occurrence, then the safer and more efficient choice is using Application.Match.

Sub DeleteBelowFirst()
    ' Uses 'Application.Match'.

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    'If ws.FilterMode Then ws.ShowAllData ' clears filters (optionally)
    
    Dim rg As Range: Set rg = ws.UsedRange
    DeleteBelowFirstString rg, 1, "x" ' , True ' True would keep the found row

End Sub

Sub DeleteBelowFirstString( _
        ByVal rg As Range, _
        ByVal ColumnIndex As Long, _
        ByVal CriteriaString As String, _
        Optional ByVal ExcludeFoundRow As Boolean = False)
    ' If the worksheet is filtered, only the filtered (visible) rows will be deleted.
    Const ProcName As String = "DeleteBelowFirstString"
    
    Dim crg As Range: Set crg = rg.Columns(ColumnIndex)
    
    Dim rIndex As Variant: rIndex = Application.Match(CriteriaString, crg, 0)
    If IsError(rIndex) Then
        MsgBox "Value not found.", vbExclamation, ProcName
        Exit Sub
    End If
    
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim rOffset As Long: rOffset = rIndex - 1
    
    If ExcludeFoundRow Then
        rOffset = rOffset   1
        If rCount = rOffset Then
            MsgBox "There's nothing below.", vbExclamation, ProcName
            Exit Sub
        End If
    End If

    Dim drg As Range: Set drg = rg.Resize(rCount - rOffset).Offset(rOffset)
    Debug.Print ProcName & ": " & drg.Address & " deleted."
    
    drg.Delete xlShiftUp

End Sub

Range.Find

If you're after the last occurrence, then Application.Match does not work and you could e.g. use Range.Find with its limitations. It will also work for a single occurrence.

Sub DeleteBelowLast()
    ' Uses 'Range.Find'.

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    If ws.FilterMode Then ws.ShowAllData ' clears filters (mandatory)
    
    Dim rg As Range: Set rg = ws.UsedRange
    DeleteBelowLastString rg, 1, "x" ' , True ' True would keep the found row

End Sub

Sub DeleteBelowLastString( _
        ByVal rg As Range, _
        ByVal ColumnIndex As Long, _
        ByVal CriteriaString As String, _
        Optional ByVal ExcludeFoundRow As Boolean = False)
    ' Make sure the worksheet is not filtered or the Find method will fail.
    Const ProcName As String = "DeleteBelowLastString"
    
    Dim crg As Range: Set crg = rg.Columns(ColumnIndex)
    
    ' If the column contains formulas, instead of 'xlFormulas', use 'xlValues'
    ' and additionally make sure that no rows are hidden
    ' or the Find method will fail (hidden rows don't affect 'xlFormulas').
    Dim fCell As Range: Set fCell = crg.Find( _
        What:=CriteriaString, After:=crg.Cells(1), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchDirection:=xlPrevious) ' last occurrence
    If fCell Is Nothing Then
        MsgBox "Value not found.", vbExclamation, ProcName
        Exit Sub
    End If
    
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim rOffset As Long: rOffset = fCell.Row - rg.Row
    
    If ExcludeFoundRow Then
        rOffset = rOffset   1
        If rCount = rOffset Then
            MsgBox "There's nothing below.", vbExclamation, ProcName
            Exit Sub
        End If
    End If
    
    Dim drg As Range: Set drg = rg.Resize(rCount - rOffset).Offset(rOffset)
    Debug.Print ProcName & ": " & drg.Address & " deleted."
    
    drg.Delete xlShiftUp

End Sub

Note that both methods support wild characters.