Delete entire row based off cell value ignoring 2nd row

[ItalianPlatinum]

Would someone be able to help me come up with a VBA code to delete all the rows where its cell value in column P = 1 but ignoring the first row of data (P2) seeing that is where the formula resides. Below is a snipbit of the code where I would need it.

With Worksheets(SheetName)
lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("M1:Q1") = Array("Rounded 2 digit Unit Cost", "Greater than 1yr", "Greater than 3yr", "For formula", "Same Occurrence")
        .Application.Calculation = xlAutomatic
        .Range("P2:P" & lr1).NumberFormat = "General"
        .Range("M2:M" & lr1).Formula = "=Round(K2, 2)"
        .Range("N2:N" & lr1).Formula = "=if(RUN-E2>365,""YES"",""NO"")"
        .Range("O2:O" & lr1).Formula = "=if(RUN-E2>(365*3),""YES"",""NO"")"
If TFLG = "N" Then
        .Range("P2:P" & lr1).Formula = "=D2&M2"
Else
        .Range("P2:P" & lr1).Formula = "=D2&E2&M2"
End If
        .Range("P2:P" & lr1).NumberFormat = "@"
        .Range("Q2").Formula2 = "=COUNTIF($P$2:$P$" & lr1 & ",$P$2:$P$" & lr1 & ")" 'need alternative takes too long
        '.Range("P2").Formula2 = "=COUNTIFS($D$2:$D$" & lr1 & ",$D$2:$D$" & lr1 & ",$M$2:$M$" & lr1 & ",$M$2:$M$" & lr1 & ")" 'combines matching and countif could help speed?
        .Range("M2:P" & lr1).Value = .Range("M2:P" & lr1).Value
        .Range("1:1").AutoFilter
        .Cells.EntireColumn.AutoFit
        .Activate
End With

 

[Trebor76]

Hi there,

Try this though initially on a copy of your data as results cannot be undone if they're not as expected (or save first then close without saving):

Option Explicit
Sub Macro1()
    
    Dim lr1 As Long
    Dim TFLG As String
    Dim rngCell As Range, rngDelete As Range
    
    Application.ScreenUpdating = False
    
    With Worksheets(SheetName)
        lr1 = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("M1:Q1") = Array("Rounded 2 digit Unit Cost", "Greater than 1yr", "Greater than 3yr", "For formula", "Same Occurrence")
        .Application.Calculation = xlAutomatic
        .Range("P2:P" & lr1).NumberFormat = "General"
        .Range("M2:M" & lr1).Formula = "=Round(K2, 2)"
        .Range("N2:N" & lr1).Formula = "=if(RUN-E2>365,""YES"",""NO"")"
        .Range("O2:O" & lr1).Formula = "=if(RUN-E2>(365*3),""YES"",""NO"")"
        If TFLG = "N" Then
            .Range("P2:P" & lr1).Formula = "=D2&M2"
        Else
            .Range("P2:P" & lr1).Formula = "=D2&E2&M2"
        End If
        .Range("P2:P" & lr1).NumberFormat = "@"
        .Range("Q2").Formula2 = "=COUNTIF($P$2:$P$" & lr1 & ",$P$2:$P$" & lr1 & ")" 'need alternative takes too long
        '.Range("P2").Formula2 = "=COUNTIFS($D$2:$D$" & lr1 & ",$D$2:$D$" & lr1 & ",$M$2:$M$" & lr1 & ",$M$2:$M$" & lr1 & ")" 'combines matching and countif could help speed?
        .Range("M2:P" & lr1).Value = .Range("M2:P" & lr1).Value
        .Range("1:1").AutoFilter
        .Cells.EntireColumn.AutoFit
        .Activate
        'Delete all rows from Col. P that equal one
        For Each rngCell In .Range("P3:P" & lr1) 'Ignore the first row of data i.e. Row 2 by starting at Row 3
            If Val(rngCell) = 1 Then
                If rngDelete Is Nothing Then
                    Set rngDelete = rngCell
                Else
                    Set rngDelete = Union(rngCell, rngDelete)
                End If
            End If
        Next rngCell
        If Not rngDelete Is Nothing Then
            rngDelete.EntireRow.Delete
        End If
    End With
    
    Application.ScreenUpdating = True
    
End Sub

Regards,

Robert

 

[ItalianPlatinum]

Hey Robert before I try i have a lot of rows like 750k would for each cause a performance drain?

 

[ItalianPlatinum]

Ran into this error code

 

[ItalianPlatinum]

I stumbled on this and going to try this out

VBA delete rows based on cell value

Hi I have one worksheet where I create text boxes and assign macros in the workbook. I am trying to create VBA to delete the row on a Worksheet named "Register" if the value of the cell in Column 16 = 0 (Zero) - so example value in Cell P4 = 0, therefore row 4 should be deleted. The number of...

www.mrexcel.com

 

[Trebor76]

Sorry, this line...

Set rngDelete = Union(rngCell, rngDelete)

...should be this:

Set rngDelete = Union(rngDelete, rngCell)

Hey Robert before I try i have a lot of rows like 750k would for each cause a performance drain?

Yes it could be slow. Try setting the calculation method to manual at the start of the macro and then back to automatic at the end. If it's still too slow use Joe4's solution you've found but also have a PeterSSs's nifty solution (thread #6) from here.

 

[ItalianPlatinum]

Thanks Robert. I will give Peters a try too!