pls help in providing a VBA code to delete a data for a specific date range

[navneetr]

I have 2 queries:

1st one: I have a large set of data and I want to delete the data that belongs to a date prior to 1 Jan 2020. The date is mentioned in the column "P"

2nd one: Same large set of data, I want to delete the data that belongs to a date prior to 1 Jan 2020 but for the Product code "A". Here, date is in column "P" and Product code is in column "Q"

Please help

 

[Logit]

This is one method :

Option Explicit

Sub delOnDate()
Dim Searchdate As Date
Dim i As Long
Dim tdate As Date
Dim endrow As Integer

Columns("P:P").Select
Selection.NumberFormat = "m/d/yyyy;@"

On Error Resume Next
endrow = Sheets("sheet2").Range("P1000").End(xlUp).Row
Searchdate = "1/1/2020"

    For i = endrow To 2 Step -1
        tdate = Cells(i, 16).Value
            If IsDate(tdate) = True And tdate < Searchdate Then
                Cells(i, 16).EntireRow.Delete
            End If
    Next i

End Sub


Sub delOnDateAndTermA()
Dim Searchdate As Date
Dim i As Long
Dim tdate As Date
Dim endrow As Integer

Columns("P:P").Select
Selection.NumberFormat = "m/d/yyyy;@"

On Error Resume Next
endrow = Sheets("sheet2").Range("P1000").End(xlUp).Row
Searchdate = "1/1/2020"

    For i = endrow To 2 Step -1
        tdate = Cells(i, 16).Value
            If IsDate(tdate) = True And tdate < Searchdate Then
                If Cells(i, 16).Offset(0, 1) = "A" Then
                    Cells(i, 16).EntireRow.Delete
                End
            End If
    Next i

End Sub

 

[MARK858]

Another method, maybe try the codes below on a Copy of your data (assumes that "data that belongs to a date" does mean that you want the entire row deleted).

Sub Filterit()
    Application.ScreenUpdating = False
    
    With Range("P1:Q" & Range("P" & Rows.Count).End(xlUp).Row)
    
        .AutoFilter 1, "<" & CLng(DateValue("1/1/2020"))
        
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        On Error GoTo 0
        
    End With
    
    ActiveSheet.AutoFilterMode = False
    
    Application.ScreenUpdating = True
End Sub

Sub Filterit2()
    Application.ScreenUpdating = False
    
    With Range("P1:Q" & Range("P" & Rows.Count).End(xlUp).Row)
    
        .AutoFilter 1, "<" & CLng(DateValue("1/1/2020"))
        .AutoFilter 2, "A"
        
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        On Error GoTo 0
    
    End With
    
    ActiveSheet.AutoFilterMode = False
    
    Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

Depends just what you mean by this.

I have a large set

If your data set is truly large (tens or hundreds of thousands of rows), I think you will find these noticeably faster.
I am also assuming you mean to delete the entire row for the relevant items.

1st one:

Sub BeforeDate()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  Dim dDate As Date
  
  dDate = DateSerial(2020, 1, 1)
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("P2", Range("P" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) < dDate Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

2nd one:

Sub BeforeDateWithCode()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  Dim dDate As Date
  Dim sCode As String
  
  dDate = DateSerial(2020, 1, 1)
  sCode = "A"
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("P2", Range("Q" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) < dDate And a(i, 2) = sCode Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub