Option Explicit 
 
Public StartClear As Integer 
 
Sub ClearDataBelowThisRow() 
     
    Dim Question As Integer 
    Dim Password, Msg, Answer, Confirm, MoreOptions As VbMsgBoxResult 
     
     '//ask for input
    On Error GoTo LastLine 
    Question = InputBox("What is the last row number you want to KEEP?", "Keep rows down to...") 
    If Question <= 0 Then Exit Sub 
    StartClear = Question + 1 
    ActiveSheet.Rows(StartClear & ":65536").Select 
     
     '//give information
    Answer = MsgBox("Clear all entries from row " & StartClear & " down?", vbYesNo, "Cleaning out " & 65536 - StartClear & " Rows") 
    If Answer = vbNo Then 
        Range("A" & StartClear).Select 
        Exit Sub 
    End If 
     
     '//request authority to delete
    Password = Application.InputBox(prompt:="Please enter password to confirm your" & _ 
    "authority to take this action...", Title:="A Password Is Required For This Action...") 
     
     '//replace 123 (below) with your own password, OR
     '//remove it by replacing "123" with "" or Empty
    If Password <> "123" Then WrongPassword Else 
     
     '//proceed with clear
    ActiveSheet.Unprotect 
     
     '//Clear or Delete? - confirm
    Confirm = MsgBox("Click YES to clear the selected region - (Leave the cell formulae," & vbLf & _ 
    "cell formatting, conditional formatting and data validation intact)" & vbLf & _ 
    "" & vbLf & _ 
    "Click NO for other choices...", vbYesNoCancel, "Confirm Details...") 
    Application.ScreenUpdating = False 
     
     '//clear formulae only
    If Confirm = vbYes Then 
        On Error Resume Next '// "error" here is: nothing to clear
        Selection.SpecialCells(xlCellTypeConstants, 23).ClearContents 
        Range("A" & StartClear).Select 
        Exit Sub 
    End If 
     
     '//if user chooses no - more details
    If Confirm = vbNo Then 
        MoreOptions = MsgBox("Click YES to clear the contents AND the formulae from the selected region." & vbLf & _ 
        "(Leave the cell formatting, conditional formatting and data validation intact)" & vbLf & _ 
        "" & vbLf & _ 
        "Click NO to Delete absolutely everything...", vbYesNoCancel, "CHOOSE CAREFULLY !") 
         
         '//normal clear contents
        If MoreOptions = vbYes Then 
            On Error Resume Next '// "error" here is: nothing to clear
            Selection.ClearContents 
            Range("A" & StartClear).Select 
            Exit Sub 
        End If 
         '//DELETE selection
        If MoreOptions = vbNo Then 
            On Error Resume Next '// will not happen
            Selection.Delete 
            Range("A" & StartClear).Select 
            Exit Sub 
        End If 
         '//cancel
        If MoreOptions = vbCancel Then 
            Range("A" & StartClear).Select 
            Exit Sub 
        End If 
         '//cancel
        If Confirm = vbCancel Then 
            Range("A" & StartClear).Select 
            Exit Sub 
        End If 
        Exit Sub 
    End If 
     
LastLine: '//an non-integer was entered for 'Question' so quit the sub
End Sub 
 '*************************************************************
 ' Error message - Wrong password was given for "ClearDataBelowThisRow"
 '*************************************************************
Private Sub WrongPassword() 
    Dim Msg As VbMsgBoxResult 
    Range("A" & StartClear).Select 
    Msg = MsgBox("Denied : - That is not the password !", vbExclamation, "Incorrect Password") 
    End 
End Sub