Excel Macro to delete specific rows

[bthumble]

Hello Everyone, I have a macro code that is supposed to delete the rows on two separate tabs based on the date that is input in a pop up text box, The problem is that the date is a formula and the macro will only delete the rows if I convert the date from a formula to a value. What modifications are needed in the code so it will work if the date is a formula?

Sub DeleteRows1()
  Dim ym As Variant
  
  ym = InputBox("Enter year-month, ex: 2023-5")
  If ym = "" Then Exit Sub
  
  If Mid(ym, 5, 1) <> "-" Then
    MsgBox "Enter year-month, ex: 2023-5", vbCritical
    Exit Sub
  End If
  If Not IsNumeric(Left(ym, 4)) Then
    MsgBox "The year is not correct", vbCritical
    Exit Sub
  End If
  If Not IsNumeric(Split(ym, "-")(1)) Then
    MsgBox "The month is not correct", vbCritical
    Exit Sub
  End If
  If Not IsDate("1/" & Split(ym, "-")(1) & "/" & Split(ym, "-")(1)) Then
    MsgBox "The date is not correct", vbCritical
    Exit Sub
  End If
  
  With Sheets("Data1").Range("BC:BC")
    .Replace ym, "#N/A", xlWhole
    On Error Resume Next
      .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
  End With
  With Sheets("Data2").Range("AE:AE")
    .Replace ym, "#N/A", xlWhole
    On Error Resume Next
      .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
  End With
  
'MsgBox "Done"
  
End Sub

 

[Akuini]

There are approximately 45,000 rows on the two tabs.

That's quite a lot. If you plan to run the macro frequently then you need a fast code. Deleting the matching rows one by one, as my code does, is slow. Deleting them in one go as what your code trying to do is faster but it would still be slow if the are a lot of non-contiguous rows to delete.
The faster way is providing a temporary helper column > mark the rows to be deleted > sort data > delete the marked rows in one go. It would be faster since the code will delete contiguous rows.
Try this:

Sub bthumble_2()
Dim ym As String
  ym = InputBox("Enter year-month, ex: 2023-5")
  If Not ym Like "####-#" Then
    MsgBox "Enter year-month, ex: 2023-5", vbCritical
    Exit Sub
  End If
Application.ScreenUpdating = False
Application.Calculation = xlManual
Call to_delete_Row("Data1", "BC", "CA", ym)  'CA as temporary helper column
Call to_delete_Row("Data2", "AE", "BA", ym)  'BA as temporary helper column
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Private Sub to_delete_Row(sh As String, xCol As String, xH As String, tx As String)
Dim i As Long, k As Long, n As Long
Dim va
With Sheets(sh)
    n = .Range(xCol & .Rows.Count).End(xlUp).Row
    va = .Columns(xCol).Resize(n)
    For i = 1 To UBound(va, 1)
        If va(i, 1) = tx Then va(i, 1) = 2 Else va(i, 1) = 1
    Next
    .Columns(xH).Resize(n) = va
    .UsedRange.Sort Key1:=.Columns(xH), Order1:=xlAscending, Header:=xlNo
    k = Application.Match(2, .Columns(xH).Resize(n), 0)
    If IsNumeric(k) Then .Range(.Cells(k, xH), .Cells(n, xH)).EntireRow.Delete
    .Columns(xH).Clear
End With
End Sub

 

[Fuji]

The original date in the data is formatted as date in column E (shown as 5/27/2024). Based on this date, I have a formula "=YEAR(E2)&"-"&MONTH(E2)" to calculate the Year-Month and is displayed as 2024-5. This is the date that I want the macro to look at and delete the specified rows.

Try change to

Sub DeleteRows1()
    Dim ym As Variant, a(1), e, i As Long
    ym = InputBox("Enter year-month, ex: 2023-5")
    If ym = "" Then Exit Sub
    If (Not ym Like "2###-[1-9]") * (Not ym Like "2###-1[0-2]") Then
      MsgBox "Enter year-month, ex: 2023-5", vbCritical
      Exit Sub
    End If
    For Each e In Array("Data1", "Data2")
        With Sheets(e)
            With Intersect(.UsedRange, .Columns("bc"))
                a(0) = .Formula: a(1) = .Value
                For i = 1 To UBound(a(0), 1)
                    If a(1)(i, 1) = ym Then a(0)(i, 1) = "#N/A"
                Next
                .Formula = a(0)
                On Error Resume Next
                .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
                On Error GoTo 0
            End With
        End With
    Next
    'MsgBox "Done"
End Sub