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