Deletes Headings when deleting rows with different criteria

Question

I have an issue when deleting rows with certain conditions because it deletes my headers too, also ¿ is there a way to improving the deleting of rows with different criteria ?

Sub RO_FilterDelete()
Dim RowToTest As Long

For RowToTest = Cells(Rows.Count, 2).End(xlUp).row To 2 Step -1

With Cells(RowToTest, 1)
    If .Value <> "ONLINE" _
    Then _
    Rows(RowToTest).EntireRow.Delete
End With

Next RowToTest

Dim RowToTest2 As Long

For RowToTest2 = Cells(Rows.Count, 2).End(xlUp).row To 2 Step -1

With Cells(RowToTest2, 6)
    If .Value <> "CONFIRMACIÓN DE INFORMACIÓN DE CONTRATO" _
    And .Value <> "ACTUALIZACIÓN DE INFORMACIÓN DE CONTRATO" _
    Then _
    Rows(RowToTest2).EntireRow.Delete
End With

Next RowToTest2
End Sub

The error comes from the macro that paste the data into the worksheet, it pastes it from A1 instead of A2, that's why the filter doesn't work.

Sub RechazosOnline()
Dim rsh As Worksheet, wb As Workbook
Dim wbCopyFrom As Workbook, wsCopyFrom As Worksheet

Set wb = Workbooks("2. Detalle_Transacciones_pendientes_rechazadas_MDM_27Ene20.xlsx")
Set wbCopyFrom = Workbooks("1. ReporteGeneral_TransaccionesDiariasMDM_20200115")
Set wsCopyFrom = wbCopyFrom.Worksheets("Detalle")
wsCopyFrom.Range("A2:I" & wsCopyFrom.Range("A" & Rows.Count).End(xlUp).row).Copy

For Each rsh In wb.Sheets
         rsh.Range("A2:I" & rsh.Range("A" & rsh.Cells.Rows.Count).End(xlUp).row).PasteSpecial xlPasteValues
     Next
End Sub

In which row are your headers? BTW you don't need `RowToTest2`. You could just reuse the existing `RowToTest` in the second loop since its value doesn't need to be preserved for any other purpose. And, of course, you could combine the two loops by building a more elaborate AND/OR test. — Variatus, Feb 14 '20 at 03:19
Use Autofilter to delete as shown [Here](https://stackoverflow.com/questions/11317172/delete-row-based-on-condition) No need to loop. — Siddharth Rout, Feb 14 '20 at 05:23
Thank you for your comments, i'm gonna check it now, the header is in the first row so i don't know why is deleting it too, im gonna try the code from below. — Zerrets, Feb 14 '20 at 15:27

score 0 · Answer 1 · answered Feb 14 '20 at 09:09

0

The both loop of your code are working for me. As Variatus sugested, maybe your header aren't on the first row.

Have a nice day !

answered Feb 14 '20 at 09:09

Puygrenier Solann

138
8

I think the error comes from when i paste the cells into the workbook, don't know for sure, gonna check it. – Zerrets Feb 14 '20 at 15:26

score 0 · Answer 2 · answered Feb 14 '20 at 13:49

Using the union method is convenient and fast.

Sub test()
    Dim rngU As Range, Rng As Range
    Dim rngDB As Range

    Set rngDB = Range("a2", Range("a" & Rows.Count).End(xlUp))

    For Each Rng In rngDB
        If Rng <> "ONLINE" Then
            If rngU Is Nothing Then
                Set rngU = Rng
            Else
                Set rngU = Union(Rng, rngU)
            End If
        End If
    Next Rng

    If Not rngU Is Nothing Then
        rngU.EntireRow.Delete
    End If

    Set rngU = Nothing
    Set rngDB = Range("b2", Range("b" & Rows.Count).End(xlUp))

    For Each Rng In rngDB
        If Not (Rng.Value = "CONFIRMACION DE INFORMACION DE CONTRATO" Or Rng.Value = "ACTUALIZACION DE INFORMACION DE CONTRATO") Then
            If rngU Is Nothing Then
                Set rngU = Rng
            Else
                Set rngU = Union(Rng, rngU)
            End If
        End If
    Next Rng

    If Not rngU Is Nothing Then
        rngU.EntireRow.Delete
    End If

End Sub

Deletes Headings when deleting rows with different criteria

2 Answers2