CODEWITHSUNDEEP
vbaexcel
ben mazor
ben mazor

Reputation: 41

Delete multiple rows based on cell value, remove lag

I'm trying to make a button macro that deletes rows based on their true/false value in the 'b' column. the issue with deleting is once it's gone, the 'for _ do' skips the one after cause the cell in the range bellow becomes the current. I came up with this alternative but it's super laggy when done in large quantities. any suggestions. also, im trying to keep the code as simple and clean as possible, I don't like too many vars because it becomes confusing when I have to review and adjust in the future. thanx

Dim inps As Integer

Sub delline()
inps = MsgBox("Are you sure you wish to delete the selected rows?", vbYesNo, "Point Of No Return")
If inps = vbYes Then
 For Each b In Range("B12", Range("B12").End(xlDown))
  For Each a In Range("B12", Range("B12").End(xlDown))
    If a.Value = True Then
     a.EntireRow.Delete
    End If
   Next a
  Next b
End If
End Sub

Upvotes: 0

Views: 981

Answers (2)

kolcinx
kolcinx

Reputation: 2233

delete from last to first. for RowIndex = RowIndexMax to RowIndexMin Step -1

Working code

Sub delline() 'Using Max-Min-Rows

    Const RowIndexMin  As Long = 12 'first row at the top. B12 => row 12.
    Const ColumnB_Index As Long = 2

    Dim UserDecision As Long
    Dim RowIndexMax  As Long 'last row at the bottom
    Dim RowIndex  As Long 'changed in every loop

    On Error GoTo Reset

    UserDecision = MsgBox("Are you sure you wish to delete the selected rows?", vbYesNo + vbQuestion, "Point Of No Return") 'you can combine vb- enumerations ;)
    If UserDecision <> vbYes Then
        Exit Sub 'just my way of avoiding unnecessary nesting.
    End If

    'Some of speet boosting settings
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    RowIndexMax = Cells(RowIndexMin, ColumnB_Index).End(xlDown).Row

    For RowIndex = RowIndexMax To RowIndexMin Step -1 'Step -1 decreases the RowIndex every loop by 1
        If Cells(RowIndex, ColumnB_Index).Value2 = True Then
            Debug.Print "Deleting row: " & RowIndex
            Rows(RowIndex).Delete
        End If
    Next

    'True's should be gone. Falses should bubbled to the top.
Reset:
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic 'assuming it was automatic at the beginning
    Application.ScreenUpdating = True
End Sub

Upvotes: 1

Maldred
Maldred

Reputation: 1104

In your code you should set Application.ScreenUpdating to False, this makes a HUGE impact on performance, but be sure to set it back to True when you're done!

Sub delline()

    Application.ScreenUpdating = False

    If (MsgBox("Are you sure you wish to delete the selected rows?", _ 
                vbYesNo, "Point Of No Return") = vbYes) Then
        For Each b In Range("B12", Range("B12").End(xlDown))
            For Each a In Range("B12", Range("B12").End(xlDown))
                If a.Value = True Then
                    a.EntireRow.Delete
                End If
            Next a
        Next b
    End If

    Application.ScreenUpdating = True

End Sub

EDIT

If all you're trying to do is strictly delete the row where in Column B has a value = FALSE, you can use the below code. I've test it and it works fine. It will delete all rows UP TO (and including) B12

Sub test1()

    Dim LastRow As Long

    Application.ScreenUpdating = False
    If (MsgBox("Are you sure you wish to delete the selected rows?", _ 
            vbYesNo, "Point Of No Return") = vbYes) Then
        With ActiveSheet
            LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            For i = LastRow To 12 Step -1
                If (.Cells(i, "B").Value = True) Then
                    .Cells(i, "B").EntireRow.Delete
                End If
            Next i
        End With
    End If
    Application.ScreenUpdating = True

End Sub

EDIT 2

This is using the direct value copy method, and it's very fast compared to all the above

Sub test1()

    Dim LastRow As Long
    Dim LastRow2 As Long
    Application.ScreenUpdating = False

    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For i = LastRow To 12 Step -1
            If (.Range("B" & i).Value = False) Then
                LastRow2 = Sheets("Sheet2").Cells(.Rows.Count, "B").End(xlUp).Row + 1
                Sheets("Sheet2").Range("B" & LastRow2).Value = .Range("B" & i).Value
               ' .Range("B" & i).EntireRow.Delete
            End If
        Next i
    End With

    Application.ScreenUpdating = True
End Sub

Unless you need all the data from the rows, I'd suggest using this one; Or you can add the other data from those rows to the loop as well. Which still will be much faster

Upvotes: 0

Related Questions