I want to delete entire row when the cell value at column 7 is "No", It didn't work well because some cell missed to delete even the cell value is "No". The macro need to run more than once to completelly delete the row which content "No" value

Sub Delete_Rows()
    Dim StartRow As Integer
    Dim LastRow As Integer
    Dim ColNum As Integer
    Dim CellVal As String

    ColNum = 7
    StartRow = 8

    Worksheets("Email_Status_Bonus").Activate
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For i = StartRow To LastRow
        CellVal = Cells(i, ColNum).Value
        If CellVal = "No" Then
            Cells(i, ColNum).EntireRow.Delete
        End If
        StartRow = StartRow   1
    Next i

End Sub

CodePudding user response：

Delete Data Rows Using AutoFilter

• Not entire rows!
• It is assumed that there is at least one empty column to the right and at least one empty row below the data i.e. possible data to the right will stay intact, while rows below will shift up as many rows as data rows were deleted.
• Possible data to the left or above the first cell will be ignored.

Option Explicit

Sub DeleteDataRows()
    
    Application.ScreenUpdating = False
    
    Dim dfrg As Range ' Data Filtered Range
    
    With ThisWorkbook.Worksheets("Email_Status_Bonus")
        ' Remove possible initial filter.
        If .FilterMode Then .ShowAllData
        ' Reference the range (has headers).
        Dim fCell As Range: Set fCell = .Range("A7")
        Dim rg As Range
        With fCell.CurrentRegion
            Set rg = fCell.Resize(.Row   .Rows.Count _
                - fCell.Row, .Column   .Columns.Count - fCell.Column)
        End With
        ' Reference the data range (no headers).
        Dim drg As Range: Set drg = rg.Resize(rg.Rows.Count - 1).Offset(1)
        ' Filter the range (has headers).
        rg.AutoFilter 7, "No"
        ' Attempt to reference the data filtered range (no headers).
        On Error Resume Next
            Set dfrg = drg.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        ' Remove the filter.
        .AutoFilterMode = False
    End With
    
    Dim IsSuccess As Boolean ' indicates if any rows were deleted
    
    ' Delete referenced filtered rows (if any).
    If Not dfrg Is Nothing Then
        dfrg.Delete xlShiftUp
        IsSuccess = True
    End If
    
    ' Save the workbook.
    'Thisworkbook.Save
    
    Application.ScreenUpdating = True
    
    ' Inform.
    If IsSuccess Then
        MsgBox "Data deleted.", vbInformation
    Else
        MsgBox "Nothing deleted.", vbExclamation
    End If

End Sub

CodePudding user response：

Please, try the next way. It does not need the backwards iteration, like it should be done in such a case. It uses an array, a dictionary and should be very fast. The problem of backwards iteration, if you delete each row at a time, is consuming Excel resources and make the code slower. The next code creates a dictionary Union range and delete it at the end:

Sub Delete_Rows_()
  Dim sh As Worksheet, lastRow As Long, arr, i As Long, dict As Object
  
  Set sh = ActiveSheet 'Worksheets("Email_Status_Bonus")
  lastRow = sh.cells(sh.rows.count, 7).End(xlUp).row
  arr = sh.Range("G1:G" & lastRow).value 'place the range in an array for faster iteration
  Set dict = CreateObject("Scripting.Dictionary")
  
  For i = 8 To UBound(arr)          'iterate beteen the array elements:
    If arr(i, 1) = "No" Then        'if condition is met:
        If Not dict.Exists(1) Then  'if dictionary with 1 key does  not exist:
            dict.Add 1, sh.Range("A" & i) 'create it, with a range as its item
        Else
            Set dict(1) = Union(dict(1), sh.Range("A" & i)) 'create a Union between existing and the new range
        End If
    End If
  Next i
  If Not dict(1) Is Nothing Then dict(1).EntireRow.Delete
End Sub

Using a dictionary in such a purpose is a fancy approach... It is the first time I tried it, to see how it works, like an experiment. A Union range can be set directly, too.

The dictionary approach may be used when you need more than one such a Union range, not knowing how many such ranges you need. The dictionary item may contain an array of Union ranges, adding such ranges when needed...

CodePudding user response：

We need to iterate from the last item, which in this case is a row, to the first when deleting. Deleting a row from a range shift the next rows changing there indeices.

Sub Delete_Rows()
    Dim StartRow As Integer
    Dim LastRow As Integer
    Dim ColNum As Integer
    Dim CellVal As String
    
    ColNum = 7
    StartRow = 8
    
    Worksheets("Email_Status_Bonus").Activate
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For i = LastRow To StartRow Step -1
        CellVal = Cells(i, ColNum).Value
        If CellVal = "No" Then
            Cells(i, ColNum).EntireRow.Delete
        End If
        StartRow = StartRow   1
    Next i
    
End Sub

Using Range.Autofilter on contiguous blocks of data will simplify and greatly speed up.

Sub DeleteVisisbleValues()
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Worksheets("Email_Status_Bonus")
        Rem Target A1 and all the contiguous (connected) data cells
        With Range("A1").CurrentRegion
            Rem Clears Existing Filter
            .AutoFilter
            
            Rem Apply Filter
            .AutoFilter 7, "No"
            
            Rem Delete Visible Rows
            .Offset(1).Delete
        End With
    End With
    
    Application.ScreenUpdating = True

End Sub

CodePudding user response：

instead of looping backwards, you could insert "i = i - 1" after "Cells(i, ColNum).EntireRow.Delete"

CodePudding user response：

why You increase StartRow , in my opinion you must decrease 1 value of "i" when macro find "No"

Sub Delete_Rows()
    Dim StartRow As Integer
    Dim LastRow As Integer
    Dim ColNum As Integer
    Dim CellVal As String
    Dim i As Integer

    ColNum = 7
    StartRow = 8

    Worksheets("Sayfa2").Activate
    LastRow = Cells(Rows.Count, ColNum).End(xlUp).Row
    For i = StartRow To LastRow
        CellVal = Cells(i, ColNum).Value
        If CellVal = "No" Then
            Cells(i, ColNum).EntireRow.Delete
    i = i - 1
    End If
    Next i
End Sub