I have a loop that is deleting rows based on the month within the date

Dim k As Long
For k = FindLastRow(.Sheets(NewSheet)) To 2 Step -1
    If Not Month(.Sheets(NewSheet).Cells(k, 1).Value) = NewMonth Then
    .Sheets(NewSheet).Rows(k).EntireRow.Delete
    End If
Next k

This is very slow and I have code that I've used elsewhere for doing this quicker, this example is based on deleting 0 values:

Dim rngDataBlock As Range
Set rngDataBlock = .Range(.Cells(1, 1), .Cells(8, 8))
With rngDataBlock
    .AutoFilter Field:=1, Criteria1:=0
    .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
End With
.AutoFilterMode = False

What I can't figure out is how to apply this to my 1st case where I'm deleting based on the month of the date. I tried:

    .AutoFilter Field:=1, Criteria1:="<>" & Month(NewMonth)

but this doesn't work, I guess as the filter is actually loking at whole dates rather than months. Can anyone help?

CodePudding user response：

You can use the second criteria and operator parameters to delete using autofilter.

    Dim rngDataBlock As Range
    Set rngDataBlock = .Range(.Cells(1, 1), .Cells(16, 2)) 
    With rngDataBlock
        .AutoFilter Field:=2, Criteria1:=">=" & DateSerial(2021, Month(newmonth), 1), _
        Operator:=xlAnd, Criteria2:="<=" & DateSerial(2021, Month(newmonth)   1, -1)

        .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
    End With
    .AutoFilterMode = False

You can also speed up your original example by unionizing the rows you want to delete and then deleting in one go.

 Dim k As Long
    Dim delrng As Range
    For k = FindLastRow(.Sheets(NewSheet)) To 2 Step -1
        If Not Month(.Sheets(NewSheet).Cells(k, 1).Value) = newmonth Then
            If delrng Is Nothing Then
                Set delrng = .Sheets(NewSheet).Rows(k).EntireRow
            Else
                Set delrng = Union(delrng, .Sheets(NewSheet).Rows(k).EntireRow)
            End If
        End If
    Next k
    delrng.Delete