Sub DeleteRowsByCurrentMonth()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dateColumn As Range
    Dim currentDate As Date
    Dim cell As Range

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Profit") ' Change "Sheet1" to your actual sheet name

    ' Find the last row in the sheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Set the date column (assuming it's in column H, change as needed)
    Set dateColumn = ws.Range("H1:H" & lastRow)

    ' Get the current month
    currentDate = Date

    ' Loop through each cell in the date column
    For Each cell In dateColumn
        ' Check if the cell value is a date
        If IsDate(cell.Value) Then
            ' Check if the month of the date is the same as the current month
            If Month(cell.Value) = Month(currentDate) Then
                ' Delete the entire row
                cell.EntireRow.Delete
            End If
        End If
    Next cell
End Sub