Const SHEET_PASSWORD As String = "1234"
 
 
 
Sub ProtectRows()
 
    'ActiveSheet.Protect Contents:=True

    Dim p As Protection
 
    Set p = ActiveSheet.Protection
 
    Dim AllwedRange As AllowEditRange
 
    For Each AllwedRange In p.AllowEditRanges
 
        AllwedRange.Delete
 
    Next AllwedRange
 
    Dim r As Range
 
    'Set r = ActiveSheet.UsedRange.Columns("A")

    Set r = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 
    Dim rCell As Range
 
    Dim i As Integer
 
    For Each rCell In r.Cells
 
        If rCell.Value >= DateValue(Now()) Then
 
            Set AllwedRange = p.AllowEditRanges.Add("Editable" & i, Rows(rCell.Row))
 
            i = i + 1
 
        End If
 
    Next rCell
 
    ActiveSheet.Protect Password:=SHEET_PASSWORD, AllowSorting:=True, AllowFiltering:=True
 
End Sub