Code:
Sub DisableEvents()
Application.EnableEvents = False
End Sub
Code:
Sub EnableEvents()
Application.EnableEvents = True
End Sub
Code:
Option Explicit
Dim LastCell As Range
Dim lcAddress$, rw&, col%, alphaCol$
Dim Msg$, M%
Dim R As Variant, C As Variant, chk%

Sub ResetLastCell()

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Set LastCell = _
    Cells(Range([A1], ActiveSheet.UsedRange).Rows.Count, _
    Range([A1], ActiveSheet.UsedRange).Columns.Count)
lcAddress = LastCell.Address(False, False)
rw = LastCell.Row
col = LastCell.Column
alphaCol = Left(lcAddress, (col < 27) + 2)
If lcAddress = "A1" Then GoTo x
If Application.CountA(Columns(col)) = 0 Or _
    Application.CountA(Rows(rw)) = 0 Then
    Msg = "The last cell in " & ActiveSheet.Name & _
        " is cell " & lcAddress & _
        "." & vbCrLf & vbCrLf & "Row " & rw & _
        " , Column " & col & " ( " & alphaCol & " )" & vbCrLf & vbCrLf & _
        "Do you wish to reset this to another cell?"
    M = MsgBox(Msg, vbYesNoCancel, "Reset Last Cell")
Else
x:
    MsgBox "The last cell in " & ActiveSheet.Name & _
    " has been reset to cell " & lcAddress & _
    "." & vbCrLf & vbCrLf & "Row " & rw & _
    " , Column " & col & " ( " & alphaCol & " )"
    Exit Sub
End If

If M = vbCancel Or M = vbNo Then Exit Sub
If M = vbYes Then
    On Error Resume Next
    Application.DisplayAlerts = False
    Set R = Application.InputBox("Select the required last row", Type:=8)
    Set C = Application.InputBox("Select the required last column", Type:=8)
    Application.DisplayAlerts = True
    If R Is Nothing Then If C Is Nothing Then GoTo e
    If Not R Is Nothing Then If C Is Nothing Then GoTo delR
    If R Is Nothing Then If Not C Is Nothing Then GoTo delC
    If Not R Is Nothing Then If Not C Is Nothing Then GoTo delRC
End If

delR:
    On Error GoTo 0
    chk = MsgBox("All rows after row " & R.Row & " will be permanently deleted." _
    & vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNoCancel, "ALERT !")
    If chk = vbCancel Or chk = vbNo Then Exit Sub
    Rows(R.Row + 1 & ":65536").Delete
    Call SetLastCell
    GoTo e
delC:
    On Error GoTo 0
    chk = MsgBox("All columns after column " & C.Column & " will be permanently deleted." _
    & vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNoCancel, "ALERT !")
    If chk = vbCancel Or chk = vbNo Then Exit Sub
    MsgBox C.Column + 1
    Range(Columns(C.Column + 1), Columns(256)).Delete
    Call SetLastCell
    GoTo e
delRC:
    On Error GoTo 0
    chk = MsgBox("All rows after row " & R.Row & " and all columns after column " & C.Column & _
    " will be permanently deleted." & vbCrLf & vbCrLf & _
    "Are you sure you want to continue?", vbYesNoCancel, "ALERT !")
    If chk = vbCancel Or chk = vbNo Then Exit Sub
    Rows(R.Row + 1 & ":65536").Delete
    Range(Columns(C.Column + 1), Columns(256)).Delete
    Call SetLastCell
    GoTo e
e:
On Error GoTo 0
End Sub

Sub SetLastCell()
Dim LastCell As Range
Set LastCell = _
Cells(Range([A1], ActiveSheet.UsedRange).Rows.Count, _
    Range([A1], ActiveSheet.UsedRange).Columns.Count)
lcAddress = LastCell.Address(False, False)
rw = LastCell.Row
col = LastCell.Column
alphaCol = Left(lcAddress, (col < 27) + 2)
MsgBox "The last cell in " & ActiveSheet.Name & _
    " has been reset to cell " & lcAddress & _
    "." & vbCrLf & vbCrLf & "Row " & rw & _
    " , Column " & col & " ( " & alphaCol & " )"
End Sub